Merge pull request #437 from Appsilon/426.fix-asis

Fix - asis bug in modal functions

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: shiny.semantic
 Type: Package
 Title: Semantic UI Support for Shiny
-Version: 0.4.3
+Version: 0.4.3.9000
 Authors@R: c(person("Filip", "Stachura", email = "[email protected]", role = "aut"),
   person("Dominik", "Krzeminski", email = "[email protected]", role = "aut"),
   person("Krystian", "Igras", email = "[email protected]", role = "aut"),
@@ -52,5 +52,6 @@ Suggests:
     plotly,
     rmarkdown,
     markdown,
-    rcmdcheck
+    rcmdcheck,
+    mockery
 RoxygenNote: 7.2.1

R/modal.R

@@ -278,15 +278,17 @@ attach_rule <- function(id, behavior, target, value) {
 #' @param session The \code{session} object passed to function given to
 #'   \code{shinyServer}.
 #' @param asis A boolean indicating if the id must be handled as is (TRUE) or
-#' will be it must be namespaced (FALSE)
+#' FALSE if it meants to be namespaced
 #' @seealso modal
 #'
 #' @rdname show_modal
 #'
 #' @export
 show_modal <- function(id, session = shiny::getDefaultReactiveDomain(),
                        asis = TRUE) {
-  id <- ifelse(inherits(session, "session_proxy"), session$ns(id), id)
+  if (!asis) {
+    id <- ifelse(inherits(session, "session_proxy"), session$ns(id), id)
+  }
   session$sendCustomMessage("showSemanticModal", list(id = id, action = "show")) # nolint
 }
 
@@ -299,7 +301,9 @@ showModal <- function(ui, session = shiny::getDefaultReactiveDomain()) {
 #' @export
 remove_modal <- function(id, session = shiny::getDefaultReactiveDomain(),
                          asis = TRUE) {
-  id <- ifelse(inherits(session, "session_proxy"), session$ns(id), id)
+  if (!asis) {
+    id <- ifelse(inherits(session, "session_proxy"), session$ns(id), id)
+  }
   shiny::removeUI(paste0("#", id))
 }
 
@@ -320,6 +324,8 @@ removeModal <- function(session = shiny::getDefaultReactiveDomain()) {
 #' @export
 hide_modal <- function(id, session = shiny::getDefaultReactiveDomain(),
                        asis = TRUE) {
-  id <- ifelse(inherits(session, "session_proxy"), session$ns(id), id)
+  if (!asis) {
+    id <- ifelse(inherits(session, "session_proxy"), session$ns(id), id)
+  }
   session$sendCustomMessage("showSemanticModal", list(id = id, action = "hide")) # nolint
 }

tests/testthat/test_modal.R

@@ -110,3 +110,85 @@ test_that("test modalDialog", {
   ))
 
 })
+
+
+testthat::test_that(
+  "show_modal with asis as TRUE sends exactly the id passed to the
+                    session$sendCustomMessage function",
+  {
+    # Prepare the stub to check what is passed to the
+    # session$sendCustomMessage method
+    stub_custom_message <-
+      function(message, parameters) {
+        list(message = message,
+             parameters = parameters)
+      }
+    mockery::stub(where = show_modal, what = "session$sendCustomMessage", stub_custom_message)
+    # Mocking the Shiny session
+    session <- shiny::MockShinySession$new()
+    # Mocking a module's session
+    module_session <- session$makeScope("new")
+    # Act
+    result <- show_modal("id", session = module_session, asis = TRUE)
+
+    # Assert
+    testthat::expect_equal(result$message, "showSemanticModal")
+    testthat::expect_equal(result$parameters$id, "id")
+    testthat::expect_equal(result$parameters$action, "show")
+  }
+)
+
+testthat::test_that(
+  "show_modal with asis as FALSE namespaces the id passed to the
+  session$sendCustomMessage function when it IS IN the context
+  of a sessionproxy (shiny module)",
+  {
+    # Prepare the stub to check what is passed to the
+    # session$sendCustomMessage method
+    stub_custom_message <- function(message, parameters) {
+        list(
+          message = message,
+          parameters = parameters
+        )
+    }
+    mockery::stub(where = show_modal, what = "session$sendCustomMessage", stub_custom_message)
+    # Mocking the Shiny session
+    session <- shiny::MockShinySession$new()
+    # Mocking a module's session
+    module_session <- session$makeScope("new")
+    # Act
+    result <- show_modal("id", session = module_session, asis = FALSE)
+
+    # Assert
+    testthat::expect_equal(result$message, "showSemanticModal")
+    testthat::expect_equal(result$parameters$id, "new-id")
+    testthat::expect_equal(result$parameters$action, "show")
+  }
+)
+
+
+testthat::test_that(
+  "show_modal with asis as FALSE do not namespace the id passed to the
+  session$sendCustomMessage function when it IS NOT in the context
+  of a sessionproxy (shiny module)",
+  {
+    # Prepare the stub to check what is passed to the
+    # session$sendCustomMessage method
+    stub_custom_message <- function(message, parameters) {
+      list(
+        message = message,
+        parameters = parameters
+      )
+    }
+    mockery::stub(where = show_modal, what = "session$sendCustomMessage", stub_custom_message)
+    # Mocking the Shiny session
+    session <- shiny::MockShinySession$new()
+    # Act
+    result <- show_modal("id", session = session, asis = FALSE)
+
+    # Assert
+    testthat::expect_equal(result$message, "showSemanticModal")
+    testthat::expect_equal(result$parameters$id, "id")
+    testthat::expect_equal(result$parameters$action, "show")
+  }
+)