add_card_button_srv - card_fun (#93)

* card_fun improvements Co-authored-by: Nikolas Burkoff <nikolas.burkoff@roche.com>
insightsengineering · Jun 30, 2022 · 6c9a05e · 6c9a05e
1 parent c43580f
commit 6c9a05e
Show file tree

Hide file tree

Showing 6 changed files with 155 additions and 27 deletions.
diff --git a/NEWS.md b/NEWS.md
@@ -2,6 +2,7 @@
 
 * Added support for the `ElementaryTree` class in the `append_table` method of `ReportCard`.
 * Added additional validation for the `card_fun` evaluation.
+* Added support for more arguments setup for a `card_fun` function in the `add_card_button_srv` module, specifically the `card_fun` could have any subset of the possible arguments.
 
 # teal.reporter 0.1.0
 

diff --git a/R/AddCardModule.R b/R/AddCardModule.R
@@ -45,13 +45,15 @@ add_card_button_ui <- function(id) {
 #' @param id `character(1)` this `shiny` module's id.
 #' @param reporter [`Reporter`] instance.
 #' @param card_fun `function` which returns a [`ReportCard`] instance,
-#' the function have at`card`argument and optional `comment`.
+#' the function has optional `card` and  `comment` arguments.
+#' If the `card` argument is added then the `ReportCard` instance is automatically created for the user.
+#' If the `comment` argument is not specified then it is added automatically at the end of the Card.
 #' @return `shiny::moduleServer`
 #' @export
 add_card_button_srv <- function(id, reporter, card_fun) {
   checkmate::assert_function(card_fun)
   checkmate::assert_class(reporter, "Reporter")
-  checkmate::assert_subset(names(formals(card_fun)), c("card", "comment"), empty.ok = FALSE)
+  checkmate::assert_subset(names(formals(card_fun)), c("card", "comment"), empty.ok = TRUE)
 
   shiny::moduleServer(
     id,
@@ -101,28 +103,31 @@ add_card_button_srv <- function(id, reporter, card_fun) {
 
       shiny::observeEvent(input$add_card_ok, {
         card_fun_args_nams <- names(formals(card_fun))
-        # The default_card is defined here because formals() returns a pairedlist object
-        # of formal parameter names and their default values. The values are missing
-        # if not defined and the missing check does not work if supplied formals(card_fun)[[1]]
-        default_card <- formals(card_fun)[[1]]
-        card <- `if`(
-          missing(default_card),
-          ReportCard$new(),
-          eval(default_card, envir = environment(card_fun))
-        )
-        has_own_comment <- length(card_fun_args_nams) == 2
-        if (has_own_comment) {
-          card <- try(card_fun(card, input$comment))
-        } else {
-          card <- try(card_fun(card))
-          if (!inherits(card, "try-error")) {
-            if (length(input$comment) > 0 && input$comment != "") {
-              card$append_text("Comment", "header3")
-              card$append_text(input$comment)
-            }
-          }
+        has_card_arg <- "card" %in% card_fun_args_nams
+        has_comment_arg <- "comment" %in% card_fun_args_nams
+
+
+        arg_list <- list()
+
+        if (has_comment_arg) {
+          arg_list <- c(arg_list, list(comment = input$comment))
         }
 
+        if (has_card_arg) {
+          # The default_card is defined here because formals() returns a pairedlist object
+          # of formal parameter names and their default values. The values are missing
+          # if not defined and the missing check does not work if supplied formals(card_fun)[[1]]
+          default_card <- formals(card_fun)$card
+          card <- `if`(
+            missing(default_card),
+            ReportCard$new(),
+            eval(default_card, envir = environment(card_fun))
+          )
+          arg_list <- c(arg_list, list(card = card))
+        }
+
+        card <- try(do.call(card_fun, arg_list))
+
         if (inherits(card, "try-error")) {
           msg <- paste0(
             "The card could not be added to the report. ",
@@ -136,6 +141,10 @@ add_card_button_srv <- function(id, reporter, card_fun) {
           )
         } else {
           checkmate::assert_class(card, "ReportCard")
+          if (!has_comment_arg && length(input$comment) > 0 && input$comment != "") {
+            card$append_text("Comment", "header3")
+            card$append_text(input$comment)
+          }
           reporter$append_cards(list(card))
           shiny::showNotification(sprintf("The card added successfully."), type = "message")
           shiny::removeModal()

diff --git a/man/add_card_button_srv.Rd b/man/add_card_button_srv.Rd
diff --git a/tests/testthat/test-addCardModule.R b/tests/testthat/test-addCardModule.R
@@ -54,7 +54,7 @@ testthat::test_that("add_card_button_srv supports custom ReportCard classes", {
   )
 })
 
-testthat::test_that("add_card_button_srv supports passing no default object to card", {
+testthat::test_that("add_card_button_srv supports passing no default object to the card", {
   card_fun <- function(card) {
     card$append_text("Test")
     card
@@ -78,7 +78,7 @@ testthat::test_that("add_card_button_srv supports passing no default object to c
 
 testthat::test_that("add_card_button_srv try the card_fun", {
   card_fun <- function(card) {
-    stop("ERROR")
+    stop("ARTIFICIAL ERROR")
   }
 
   shiny::testServer(
@@ -89,4 +89,116 @@ testthat::test_that("add_card_button_srv try the card_fun", {
       expect_warning(session$setInputs(`add_card_ok` = 0))
     }
   )
+
+  card_fun <- function(card, comment) {
+    stop("ARTIFICIAL ERROR")
+  }
+
+  shiny::testServer(
+    add_card_button_srv,
+    args = list(reporter = Reporter$new(), card_fun = card_fun),
+    expr = {
+      session$setInputs(`add_report_card_button` = 0)
+      expect_warning(session$setInputs(`add_card_ok` = 0))
+    }
+  )
+
+  card_fun <- function() {
+    stop("ARTIFICIAL ERROR")
+  }
+
+  shiny::testServer(
+    add_card_button_srv,
+    args = list(reporter = Reporter$new(), card_fun = card_fun),
+    expr = {
+      session$setInputs(`add_report_card_button` = 0)
+      expect_warning(session$setInputs(`add_card_ok` = 0))
+    }
+  )
+})
+
+testthat::test_that("add_card_button_srv supports passing card_fun with any of the 2 available arguments", {
+  card_fun <- function() {
+    card <- ReportCard$new()
+    card$append_text("Test")
+    card
+  }
+
+  shiny::testServer(
+    add_card_button_srv,
+    args = list(reporter = Reporter$new(), card_fun = card_fun),
+    expr = {
+      card_len <- length(card_fun()$get_content())
+      session$setInputs(`add_report_card_button` = 0)
+      session$setInputs(`add_card_ok` = 0)
+
+      testthat::expect_identical(
+        length(reporter$get_blocks()),
+        card_len
+      )
+    }
+  )
+
+  card_fun <- function(card) {
+    card <- ReportCard$new()
+    card$append_text("Test")
+    card
+  }
+
+  shiny::testServer(
+    add_card_button_srv,
+    args = list(reporter = Reporter$new(), card_fun = card_fun),
+    expr = {
+      card_len <- length(card_fun(ReportCard$new())$get_content())
+      session$setInputs(`add_report_card_button` = 0)
+      session$setInputs(`add_card_ok` = 0)
+
+      testthat::expect_identical(
+        length(reporter$get_blocks()),
+        card_len
+      )
+    }
+  )
+
+  card_fun <- function(comment) {
+    card <- ReportCard$new()
+    card$append_text("Test")
+    card
+  }
+
+  shiny::testServer(
+    add_card_button_srv,
+    args = list(reporter = Reporter$new(), card_fun = card_fun),
+    expr = {
+      card_len <- length(card_fun("")$get_content())
+      session$setInputs(`add_report_card_button` = 0)
+      session$setInputs(`add_card_ok` = 0)
+
+      testthat::expect_identical(
+        length(reporter$get_blocks()),
+        card_len
+      )
+    }
+  )
+
+  card_fun <- function(comment, card) {
+    card <- ReportCard$new()
+    card$append_text("Test")
+    card
+  }
+
+  shiny::testServer(
+    add_card_button_srv,
+    args = list(reporter = Reporter$new(), card_fun = card_fun),
+    expr = {
+      card_len <- length(card_fun("", ReportCard$new())$get_content())
+      session$setInputs(`add_report_card_button` = 0)
+      session$setInputs(`add_card_ok` = 0)
+
+      testthat::expect_identical(
+        length(reporter$get_blocks()),
+        card_len
+      )
+    }
+  )
 })
diff --git a/vignettes/previewerReporter.Rmd b/vignettes/previewerReporter.Rmd
@@ -25,10 +25,12 @@ The implementation should consist of 5 steps:
 1. Create a `tabsetPanel` with the main app and the Previewer.
 2. Add modules user interface to the user interface of the app.
 3. Initialize Reporter instance.
-4. Create the Report Card function with two arguments: card and comment.
+4. Create the Report Card function with two optional arguments: card and comment.
+This function must return a `ReportCard` object.
 The function should build the Card step by step and assuming it is empty at the beginning,
 the optional comment argument is a string provided by the user when the card is added.
 If the comment argument is not specified then it is added automatically at the end of the Card.
+If the card argument is added then the `ReportCard` instance is automatically created for the user, otherwise the function should create the card itself.
 This part requires the developer to use their imagination as to what the document page should look like.
 5. Invoke the servers with the reporter instance and the function to create the report card instance.
 

diff --git a/vignettes/simpleReporter.Rmd b/vignettes/simpleReporter.Rmd
@@ -29,10 +29,12 @@ The implementation should consist of 4 steps:
 
 1. Add modules user interface to the user interface of the app.
 2. Initialize Reporter instance.
-3. Create the Report Card function with two arguments: card and comment.
+3. Create the Report Card function with two optional arguments: card and comment.
+This function must return a `ReportCard` object.
 The function should build the Card step by step and assuming it is empty at the beginning,
 the optional comment argument is a string provided by the user when the card is added.
 If the comment argument is not specified then it is added automatically at the end of the Card.
+If the card argument is added then the `ReportCard` instance is automatically created for the user otherwise the function should create the card itself.
 This part requires the developer to use their imagination as to what the document page should look like.
 4. Invoke the servers with the reporter instance and the function to create the report card instance.