Merge pull request #41 from Appsilon/codecov

chore: Refactors functions to build better unit tests

Author: andyquinterom

R/inputs.R

@@ -120,6 +120,16 @@ date_extra <- function(id, key = NULL, ...) {
   )
 }
 
+build_dropdown_extra_choices <- function(choices) {
+  if (length(choices) == 0) {
+    choices_js <- ""
+  } else {
+    choices_js <- paste0(", choices: ", rjson::toJSON(choices))
+  }
+
+  return(choices_js)
+}
+
 #' Select input for reactable column cell
 #'
 #' @param id id of the select input
@@ -137,11 +147,8 @@ date_extra <- function(id, key = NULL, ...) {
 #'
 #' @export
 dropdown_extra <- function(id, choices, key = NULL, ...) {
-  if (length(choices) == 0) {
-    choices_js <- ""
-  } else {
-    choices_js <- paste0(", choices: ", rjson::toJSON(choices))
-  }
+
+  choices_js <- build_dropdown_extra_choices(choices)
 
   key <- define_key(key)
 

R/reactable-server.R

@@ -242,6 +242,17 @@ hide_internal_uuid <- function(args) {
   return(args)
 }
 
+sort_table <- function(data, column_name, direction) {
+  column_name <- rlang::sym(column_name)
+  if (direction == "asc") {
+    data |>
+      dplyr::arrange(!!column_name)
+  } else if (direction == "desc") {
+    data |>
+      dplyr::arrange(dplyr::desc(!!column_name))
+  }
+}
+
 #' @rdname reactable-extras-server
 #' @export
 reactable_extras_server <- function(id, data, total_pages = 4, sortable = TRUE, ...) {
@@ -294,17 +305,10 @@ reactable_extras_server <- function(id, data, total_pages = 4, sortable = TRUE,
           reactable_data()
       } else {
         column_name <- rlang::sym(names(column_sort()))
-        data <- if (column_sort()[[1]] == "asc") {
-          data |>
-            dplyr::arrange(!!column_name) |>
-            get_data_on_page(page_number = page_number(), total_pages = total_pages) |>
-            reactable_data()
-        } else if (column_sort()[[1]] == "desc") {
-          data |>
-            dplyr::arrange(dplyr::desc(!!column_name)) |>
-            get_data_on_page(page_number = page_number(), total_pages = total_pages) |>
-            reactable_data()
-        }
+        data |>
+          get_data_on_page(page_number = page_number(), total_pages = total_pages) |>
+          sort_table(column_name = column_name, direction = column_sort()[[1]]) |>
+          reactable_data()
       }
 
       reactable::updateReactable("reactable", data = reactable_data())

tests/testthat/test-inputs.R

@@ -5,3 +5,50 @@ test_that("`args_js` returns correct output", {
 
   expect_equal(args, ", a: 'one', b: 'two'")
 })
+
+test_that("`args_js` correctly remaps class to className", {
+  args <- args_js(class = "my-class")
+
+  expect_equal(args, ", class: 'my-class', className: 'my-class'")
+})
+
+test_that("`define_key` correctly defines a key", {
+  key <- define_key("mykey")
+
+  expect_equal(key, "cellInfo.row.mykey")
+})
+
+test_that("`define_key` correctly defines a key when key is null", {
+  key <- define_key(NULL)
+
+  expect_equal(key, paste(
+    "cellInfo.row['.internal_uuid'] ?",
+    "cellInfo.row['.internal_uuid'] :",
+    "(Number(cellInfo.id) + 1)"
+  ))
+})
+
+test_that("`dropdown_extra` sets choices to blank when length is 0", {
+  choices <- build_dropdown_extra_choices(character(0))
+
+  expect_equal(choices, "")
+})
+
+test_that("`dropdown_extra` sets choices correctly", {
+  choices <- build_dropdown_extra_choices(letters[1:3])
+
+  expect_equal(choices, ", choices: [\"a\",\"b\",\"c\"]")
+})
+
+test_that("expect tooltip to return JS_EVAL object", {
+  expect_s3_class(tooltip_extra("This is my tool-tip", theme = "material"), "JS_EVAL")
+})
+
+test_that("expect inputs to return JS_EVAL object", {
+  expect_s3_class(button_extra("button"), "JS_EVAL")
+  expect_s3_class(checkbox_extra("checkbox"), "JS_EVAL")
+  expect_s3_class(date_extra("date"), "JS_EVAL")
+  expect_s3_class(dropdown_extra("dropdown", letters[1:3]), "JS_EVAL")
+  expect_s3_class(text_extra("text"), "JS_EVAL")
+  expect_s3_class(button_extra("button"), "JS_EVAL")
+})

tests/testthat/test-reactable-server.R

@@ -250,3 +250,18 @@ test_that("reactable_extras_server should return the correct data subset", {
     }
   )
 })
+
+test_that("tables are sorted correctly according to direction", {
+  mtcars_with_id <- mutate(mtcars, row_id = row_number())
+
+  expect_equal(
+    sort_table(mtcars_with_id, "row_id", "asc")$row_id,
+    1:32
+  )
+
+  expect_equal(
+    sort_table(mtcars_with_id, "row_id", "desc")$row_id,
+    32:1
+  )
+
+})