diff --git a/DESCRIPTION b/DESCRIPTION index 26df9b7..41a3fde 100644 --- a/DESCRIPTION +++ b/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' - 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' + 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 diff --git a/NAMESPACE b/NAMESPACE index f281ce6..92a675d 100644 --- a/NAMESPACE +++ b/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) diff --git a/R/methods.R b/R/methods.R index c2fabe7..355d18d 100644 --- a/R/methods.R +++ b/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") + diff --git a/R/modules.R b/R/modules.R new file mode 100644 index 0000000..f87d9f6 --- /dev/null +++ b/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() +} diff --git a/R/zzz.R b/R/zzz.R index 1598598..5a16b53 100644 --- a/R/zzz.R +++ b/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) { diff --git a/README.md b/README.md index 95f01b0..6d169e5 100644 --- a/README.md +++ b/README.md @@ -1,5 +1,4 @@ - # sortable diff --git a/_pkgdown.yml b/_pkgdown.yml index 8d7ce0d..d2d82bd 100644 --- a/_pkgdown.yml +++ b/_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 diff --git a/inst/shiny/modules/app.R b/inst/shiny/modules/app.R new file mode 100644 index 0000000..2d2cc20 --- /dev/null +++ b/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) diff --git a/inst/shiny/update_rank_list_method/app.R b/inst/shiny/update_rank_list/app.R similarity index 100% rename from inst/shiny/update_rank_list_method/app.R rename to inst/shiny/update_rank_list/app.R diff --git a/man/modules.Rd b/man/modules.Rd new file mode 100644 index 0000000..89ea0b2 --- /dev/null +++ b/man/modules.Rd @@ -0,0 +1,23 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/modules.R +\name{is_modules_enabled} +\alias{is_modules_enabled} +\alias{enable_modules} +\title{Check if shiny modules are enabled for \code{sortable}.} +\usage{ +is_modules_enabled() + +enable_modules(enable = TRUE) +} +\arguments{ +\item{enable}{If \code{TRUE}, enables modules. If \code{FALSE} disables them.} +} +\value{ +Logical value indicating whether shiny modules are enabled or not. +} +\description{ +Due to an early (regrettable) design decision, \code{sortable} in versions <= 0.5.0 +did not support shiny modules. +To use \code{sortable} with shiny modules, you have to opt in to different +behaviour, by calling \code{enable_modules()}. +} diff --git a/man/sortable.Rd b/man/sortable.Rd index 0ddfece..d0343c9 100644 --- a/man/sortable.Rd +++ b/man/sortable.Rd @@ -49,13 +49,13 @@ Useful links: Authors: \itemize{ - \item Barret Schloerke \email{barret@rstudio.com} + \item Barret Schloerke \email{barret@posit.co} \item Kenton Russell \email{kent.russell@timelyportfolio.com} (Original author) [conceptor] } Other contributors: \itemize{ - \item RStudio [copyright holder, funder] + \item Posit [copyright holder, funder] \item Lebedev Konstantin ('SortableJS', https://sortablejs.github.io/Sortable/) [copyright holder] } diff --git a/sortable.Rproj b/sortable.Rproj index 61d9e4a..79948c3 100644 --- a/sortable.Rproj +++ b/sortable.Rproj @@ -1,4 +1,5 @@ Version: 1.0 +ProjectId: f5b175a3-1218-4e55-8f73-192b92827f27 RestoreWorkspace: Default SaveWorkspace: Default diff --git a/tests/testthat/_snaps/linux-4.2/shinytest2/test_update_title-001.png b/tests/testthat/_snaps/linux-4.2/shinytest2/test_update_title-001.png new file mode 100644 index 0000000..034c62c Binary files /dev/null and b/tests/testthat/_snaps/linux-4.2/shinytest2/test_update_title-001.png differ diff --git a/tests/testthat/_snaps/linux-4.2/shinytest2/test_update_title-002.png b/tests/testthat/_snaps/linux-4.2/shinytest2/test_update_title-002.png new file mode 100644 index 0000000..b7e5005 Binary files /dev/null and b/tests/testthat/_snaps/linux-4.2/shinytest2/test_update_title-002.png differ diff --git a/tests/testthat/_snaps/shinytest2/test_change_labels-001.json b/tests/testthat/_snaps/shinytest2/test_change_labels-001.json new file mode 100644 index 0000000..07bd362 --- /dev/null +++ b/tests/testthat/_snaps/shinytest2/test_change_labels-001.json @@ -0,0 +1,5 @@ +{ + "output": { + "results": "[1] \"a\" \"b\" \"c\" \"d\" \"e\"" + } +} diff --git a/tests/testthat/_snaps/shinytest2/test_change_labels-001_.png b/tests/testthat/_snaps/shinytest2/test_change_labels-001_.png new file mode 100644 index 0000000..93d2186 Binary files /dev/null and b/tests/testthat/_snaps/shinytest2/test_change_labels-001_.png differ diff --git a/tests/testthat/_snaps/shinytest2/test_change_labels-002.json b/tests/testthat/_snaps/shinytest2/test_change_labels-002.json new file mode 100644 index 0000000..7fc5c92 --- /dev/null +++ b/tests/testthat/_snaps/shinytest2/test_change_labels-002.json @@ -0,0 +1,5 @@ +{ + "output": { + "results": "[1] \"W\" \"C\" \"R\" \"F\" \"I\"" + } +} diff --git a/tests/testthat/_snaps/shinytest2/test_change_labels-002_.png b/tests/testthat/_snaps/shinytest2/test_change_labels-002_.png new file mode 100644 index 0000000..2b49697 Binary files /dev/null and b/tests/testthat/_snaps/shinytest2/test_change_labels-002_.png differ diff --git a/tests/testthat/_snaps/shinytest2/test_empty_labels-001.json b/tests/testthat/_snaps/shinytest2/test_empty_labels-001.json new file mode 100644 index 0000000..07bd362 --- /dev/null +++ b/tests/testthat/_snaps/shinytest2/test_empty_labels-001.json @@ -0,0 +1,5 @@ +{ + "output": { + "results": "[1] \"a\" \"b\" \"c\" \"d\" \"e\"" + } +} diff --git a/tests/testthat/_snaps/shinytest2/test_empty_labels-001_.png b/tests/testthat/_snaps/shinytest2/test_empty_labels-001_.png new file mode 100644 index 0000000..93d2186 Binary files /dev/null and b/tests/testthat/_snaps/shinytest2/test_empty_labels-001_.png differ diff --git a/tests/testthat/_snaps/shinytest2/test_empty_labels-002.json b/tests/testthat/_snaps/shinytest2/test_empty_labels-002.json new file mode 100644 index 0000000..100d000 --- /dev/null +++ b/tests/testthat/_snaps/shinytest2/test_empty_labels-002.json @@ -0,0 +1,5 @@ +{ + "output": { + "results": "NULL" + } +} diff --git a/tests/testthat/_snaps/shinytest2/test_empty_labels-002_.png b/tests/testthat/_snaps/shinytest2/test_empty_labels-002_.png new file mode 100644 index 0000000..446b192 Binary files /dev/null and b/tests/testthat/_snaps/shinytest2/test_empty_labels-002_.png differ diff --git a/tests/testthat/_snaps/shinytest2/test_empty_labels-003.json b/tests/testthat/_snaps/shinytest2/test_empty_labels-003.json new file mode 100644 index 0000000..95dd78c --- /dev/null +++ b/tests/testthat/_snaps/shinytest2/test_empty_labels-003.json @@ -0,0 +1,5 @@ +{ + "output": { + "results": "[1] \"M\" \"I\" \"Z\" \"W\" \"Q\"" + } +} diff --git a/tests/testthat/_snaps/shinytest2/test_empty_labels-003_.png b/tests/testthat/_snaps/shinytest2/test_empty_labels-003_.png new file mode 100644 index 0000000..12a4433 Binary files /dev/null and b/tests/testthat/_snaps/shinytest2/test_empty_labels-003_.png differ diff --git a/tests/testthat/app.R b/tests/testthat/app.R new file mode 100644 index 0000000..870a8cd --- /dev/null +++ b/tests/testthat/app.R @@ -0,0 +1,83 @@ +## ---- update-rank-list-method-app --------------------------------------- +## Example shiny app that dynamically updates a rank list + +library(shiny) +library(sortable) +library(magrittr) + + +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( + h2("Exercise"), + width = 12, + rank_list( + text = "Change the order", + labels = letters[1:5], + input_id = "rank_list_1" + ) + ) + ), + verbatimTextOutput("results") +) + +server <- function(input, output, session) { + + # test updating the bucket list label + 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) + + +} + +shinyApp(ui, server) diff --git a/tests/testthat/setup-shinytest2.R b/tests/testthat/setup-shinytest2.R new file mode 100644 index 0000000..be65b4f --- /dev/null +++ b/tests/testthat/setup-shinytest2.R @@ -0,0 +1,2 @@ +# Load application support files into testing environment +shinytest2::load_app_env() diff --git a/tests/testthat/test-modules.R b/tests/testthat/test-modules.R new file mode 100644 index 0000000..8d065d5 --- /dev/null +++ b/tests/testthat/test-modules.R @@ -0,0 +1,12 @@ +test_that("ids and modules are consistent", { + expect_false(is_modules_enabled()) + expect_equal(as_rank_list_id("one"), "rank-list-one") + + enable_modules() + expect_true(is_modules_enabled()) + expect_equal(as_rank_list_id("one"), "one-rank-list") + + enable_modules(FALSE) + expect_false(is_modules_enabled()) + expect_equal(as_rank_list_id("one"), "rank-list-one") +}) diff --git a/tests/testthat/test-shinytest2.R b/tests/testthat/test-shinytest2.R new file mode 100644 index 0000000..80c2369 --- /dev/null +++ b/tests/testthat/test-shinytest2.R @@ -0,0 +1,71 @@ +library(shinytest2) + +app_dir <- system.file("shiny/update_rank_list", package = "sortable") + +test_that("{shinytest2} recording: test_update_title", { + skip_on_cran() + skip_on_ci() + + app <- AppDriver$new( + variant = platform_variant(), + name = "test_update_title", + app_dir = app_dir, + seed = 123, + height = 945, + width = 1619 + ) + app$expect_screenshot() + app$click("btnUpdateRank") + app$expect_screenshot() +}) + + +test_that("{shinytest2} recording: test_change_labels", { + skip_on_cran() + skip_on_ci() + + app <- AppDriver$new( + name = "test_change_labels", + app_dir = app_dir, + seed = 123, + height = 945, + width = 1619 + ) + app$expect_values(output = "results") + app$click("btnChangeLabels") + app$set_inputs( + rank_list_1 = c("W", "C", "R", "F", "I"), + allow_no_input_binding_ = TRUE, + priority_ = "event" + ) + app$expect_values(output = "results") +}) + + +test_that("{shinytest2} recording: test_empty_labels", { + skip_on_cran() + skip_on_ci() + + app <- AppDriver$new( + name = "test_empty_labels", + app_dir = app_dir, + seed = 123, + height = 945, + width = 1619 + ) + app$expect_values(output = "results") + app$click("btnEmptyLabels") + app$set_inputs( + rank_list_1 = character(0), + allow_no_input_binding_ = TRUE, + priority_ = "event" + ) + app$expect_values(output = "results") + app$click("btnChangeLabels") + app$set_inputs( + rank_list_1 = c("M", "I", "Z", "W", "Q"), + allow_no_input_binding_ = TRUE, + priority_ = "event" + ) + app$expect_values(output = "results") +}) diff --git a/vignettes/shiny_modules.Rmd b/vignettes/shiny_modules.Rmd new file mode 100644 index 0000000..1680ab0 --- /dev/null +++ b/vignettes/shiny_modules.Rmd @@ -0,0 +1,99 @@ +--- +title: "Using `sortable` with `shiny` modules" +output: rmarkdown::html_vignette +description: > + This vignette explains how to use sortable with `shiny` modules, including how to enable module support and how ID handling works with modules. +vignette: > + %\VignetteIndexEntry{Using `sortable` with `shiny` modules} + %\VignetteEngine{knitr::rmarkdown} + %\VignetteEncoding{UTF-8} +--- + +```{r, include = FALSE} +knitr::opts_chunk$set( + collapse = TRUE, + comment = "#>" +) +``` + +```{css, echo=FALSE} +pre { + max-height: 15em; + overflow-y: auto; +} + +pre[class] { + max-height: 15em; +} +``` + + +## tl;dr + +If you use `sortable` with `shiny` modules, opt into a fix by adding this line of code to your app: + +```r +enable_modules(TRUE) # or simply enable_modules() +``` + + +## Introduction + +Shiny modules provide a way to create reusable components in Shiny applications. When working with modules, namespacing of input and output IDs is crucial. + +Due to an early design decision, the `sortable` package (`versions <= 0.5.0`) did not fully support Shiny modules. + +This vignette explains how to use sortable with Shiny modules and the changes that were made to support this functionality. + + +## Understanding the Module Namespacing Issue + +In Shiny modules, element IDs are automatically namespaced using a prefix followed by a dash. For example, if you create a module with ID "mymodule" and an input with ID "myinput", Shiny will create an ID like "mymodule-myinput". + +Initially, the `sortable` package used ID formats that were incompatible with this namespacing approach. The IDs were created as `rank-list-{id}` or `bucket-list-{id}`, which placed the key part at the beginning of the ID. + + + +## Enabling and disabling shiny modules support + +The `sortable` package provides functions to control whether module support is enabled: + + +To check if module support is currently enabled: + +```r +is_modules_enabled() +``` + + +To enable module support: + +```r +enable_modules(TRUE) # or simply enable_modules() +``` + +When module support is enabled, the ID format changes: +- `as_rank_list_id("myid")` will return `"myid-rank-list"` (instead of `"rank-list-myid"`) +- `as_bucket_list_id("myid")` will return `"myid-bucket-list"` (instead of `"bucket-list-myid"`) + +This change puts the key part at the end, making it compatible with Shiny's module namespacing system. + + +To disable module support (reverting to pre-0.5.0 behavior): + +```r +enable_modules(FALSE) +``` + + +### Backward Compatibility + +The fix was designed to be backward compatible: + +1. By default, module mode is disabled (`sortable_env$modules = FALSE`) +2. Users must explicitly opt-in by calling `enable_modules()` +3. Existing code that doesn't use modules continues to work without changes + +This approach ensures that existing applications won't break, while providing a path forward for applications that need module support. + +