reactable: Interactive Data Tables for R

library(htmltools)

test_that("mergeLists", {
  a <- list(a = 1, b = "b", c = 3)
  b <- list(a = 2, c = 4, d = "d")
  expect_equal(mergeLists(a, b), list(a = 2, b = "b", c = 4, d = "d"))

  a <- list(a = 1, b = 2)
  b <- list()
  expect_equal(mergeLists(a, b), list(a = 1, b = 2))

  a <- list()
  b <- list(a = 1, b = 2)
  expect_equal(mergeLists(a, b), list(a = 1, b = 2))

  a <- list(a = NULL, b = 2)
  b <- list(a = 1, b = NULL)
  expect_equal(mergeLists(a, b), list(a = 1, b = 2))

  expect_equal(mergeLists(NULL, list(a = 1, b = 2)), list(a = 1, b = 2))
  expect_equal(mergeLists(list(a = 1, b = 2), NULL), list(a = 1, b = 2))

  a <- list(a = NULL, b = 2, 3)
  b <- list(a = 1, b = NULL, 4)
  expect_equal(mergeLists(a, b), list(a = 1, b = 2, 3, 4))

  a <- list(a = NULL, b = 2)
  b <- list(1, 2, 3)
  expect_equal(mergeLists(a, b), list(a = NULL, b = 2, 1, 2, 3))
})

test_that("filterNulls", {
  expect_equal(filterNulls(list(a = 1, b = NULL, c = NULL, d = 2)), list(a = 1, d = 2))
  expect_equal(filterNulls(list(a = 1, b = "b")), list(a = 1, b = "b"))
  expect_equal(filterNulls(list(a = 1, 2, b = NULL)), list(a = 1, 2))
  expect_equal(filterNulls(list(1, NULL, 2)), list(1, 2))
})

test_that("asJSONList", {
  expect_equal(as.character(toJSON(asJSONList("x"))), '["x"]')
  expect_equal(as.character(toJSON(asJSONList(c(1, 2)))), '[1,2]')
  expect_equal(as.character(toJSON(asJSONList(c()))), 'null')
  expect_equal(asJSONList(NULL), NULL)
})

test_that("isNamedList", {
  expect_true(isNamedList(list()))
  expect_true(isNamedList(list(a = 1, b = 2)))
  expect_false(isNamedList(list(1)))
  expect_false(isNamedList(list(1, a = 2)))
  expect_false(isNamedList(NULL))
  expect_false(isNamedList("a"))
})

test_that("is.tag", {
  expect_true(is.tag(tags$div()))
  expect_false(is.tag(list()))
})

test_that("is.htmlwidget", {
  expect_true(is.htmlwidget(reactable(data.frame(x = 1))))
  expect_false(is.htmlwidget(div()))
})

test_that("is.htmlDependency", {
  dep <- htmlDependency("dep", "0.1.0", "/path/to/dep")
  expect_true(is.htmlDependency(dep))
  expect_false(is.htmlDependency(div()))
})

test_that("isTagList", {
  expect_true(isTagList(tagList()))
  expect_true(isTagList(tagList("a")))
  expect_true(isTagList(tagList(1, div())))
  expect_true(isTagList(list(div(), span())))
  expect_false(isTagList(div()))
  expect_false(isTagList(list(div(), list())))
})

test_that("asReactTag", {
  # Nodes should be strings
  expect_equal(asReactTag("text"), "text")
  expect_equal(asReactTag("\u2718"), "\u2718")
  expect_equal(asReactTag(123), "123")
  expect_equal(asReactTag(TRUE), "TRUE")
  expect_equal(asReactTag(NA), "NA")  # should be "NA" rather than NA_character_
  expect_equal(asReactTag(NA_character_), "NA")  # should be "NA" rather than NA_character_
  expect_equal(asReactTag(factor("xy")), "xy")
  expect_equal(asReactTag(as.Date("2019-01-03")), "2019-01-03")
  expect_equal(asReactTag(list("text")), "text")
  # NULLs should be left as-is
  expect_equal(asReactTag(NULL), NULL)

  # Tags should be extracted from nested tables
  tag <- asReactTag(reactable(data.frame(x = 1)))
  expect_true(is.tag(tag))
  # Nested tables should be marked
  expect_true(tag$attribs$nested)

  # All other htmlwidgets should be converted to tags
  tbl <- reactable(data.frame(x = 1))
  class(tbl) <- c("my-widget", "htmlwidget")
  tag <- asReactTag(tbl)
  expect_equal(tag$name, "WidgetContainer")
  expect_equal(tag$attribs, list(key = digest::digest(tbl)))
  expect_equal(findDependencies(tag), findDependencies(tbl))
  expect_equal(length(tag$children), 1)
  expect_equal(tag$children[[1]]$name, "Fragment")

  # Tag lists should be unnested and wrapped in fragments
  expect_equal(asReactTag(tagList()), reactR::React$Fragment())
  expect_equal(asReactTag(tagList(div("x"))), reactR::React$Fragment(div("x")))
  expect_equal(asReactTag(tagList(div(), "x")), reactR::React$Fragment(div(), "x"))
  # htmlwidgets in tag lists
  tag <- asReactTag(tagList(reactable(data.frame(x = 1)), "y"))
  expect_equal(length(tag$children), 2)
  expect_true(is.tag(tag$children[[1]]))
  expect_equal(tag$children[[2]], "y")

  # Nested tags should be unnested
  nestedTag <- div(
    list(
      div(),
      div(list(div()))
    )
  )
  expected <- div(
    div(),
    div(div())
  )
  expect_equal(asReactTag(nestedTag), expected)

  nestedTag <- div(
    tagList("a", div(
      tagList("b", span("c", class = "c"))
    ))
  )
  expected <- div("a", div("b", span("c", className = "c")))
  expect_equal(asReactTag(nestedTag), expected)

  nestedTagList <- tagList(
    div(class = "a"),
    tagList(
      div(),
      tagList("x", span("y", class = "y"))
    )
  )
  expected <- reactR::React$Fragment(
    div(className = "a"),
    div(),
    "x",
    span("y", className = "y")
  )
  expect_equal(asReactTag(nestedTagList), expected)

  # Null elements should be pruned
  expect_equal(asReactTag(div(1, NULL, 3)), div("1", "3"))
  expect_equal(asReactTag(tagList(NULL, "a", tagList(NULL, "b", NULL), div(NULL, "c"))),
               reactR::React$Fragment("a", "b", div("c")))

  # Attributes should be converted
  expect_equal(asReactTag(div(style = "color: red", class = "cls")),
               div(style = list(color = "red"), className = "cls"))

  # Attributes should be preserved
  expect_equal(asReactTag(div(factor("xy"))), div("xy"))
  expect_equal(asReactTag(div(div(as.Date("2019-01-03")))), div(div("2019-01-03")))

  # Duplicate attributes should be included and collapsed (e.g., for likelihood of
  # duplicate class attributes in HTML widgets with htmlwidgets >= 1.6.0)
  expect_equal(asReactTag(div(class = "a", class = "b")), div(className = "a b"))
  expect_equal(
    asReactTag(span(class = "a", test = "t", style = list(color = "red"), class = "bb", style = list(color = "blue"))),
    span(test = "t", style = list(list(color = "red"), list(color = "blue")), className = "a bb")
  )
})

test_that("asReactTag preserves HTML dependencies", {
  dep <- htmlDependency("dep", "0.1.0", "/path/to/dep")
  dep2 <- htmlDependency("dep2", "0.5.0", "/path/to/dep2")

  # Single tag
  tag <- attachDependencies(div(div("x")), dep)
  expect_equal(htmlDependencies(asReactTag(tag)), list(dep))

  # Tag w/ nested deps
  tag <- div(attachDependencies(div("x"), dep))
  expect_equal(htmlDependencies(asReactTag(tag)$children[[1]]), list(dep))

  # Multiple nested deps
  tag <- div(attachDependencies(div("x"), dep2), attachDependencies(div("x"), dep))
  expect_equal(findDependencies(asReactTag(tag)), list(dep2, dep))

  # Tag list
  tag <- attachDependencies(tagList(div("x")), dep)
  expect_equal(htmlDependencies(asReactTag(tag)), list(dep))

  # Tag list w/ nested tag deps
  tag <- attachDependencies(tagList(div("x"), attachDependencies(div("y"), dep)), dep2)
  expect_equal(findDependencies(asReactTag(tag)), list(dep, dep2))

  # Tag list w/ nested tag list deps
  tag <- attachDependencies(tagList(div("x"), attachDependencies(tagList("y"), dep)), dep2)
  expect_equal(findDependencies(asReactTag(tag)), list(dep2, dep))

  # Tag w/ nested tag list deps
  tag <- div(attachDependencies(tagList(div("x")), dep), div("y"))
  expect_equal(findDependencies(asReactTag(tag)), list(dep))

  # HTML dependency objects
  tag <- tagList("x", "y", dep)
  expect_equal(asReactTag(tag), attachDependencies(reactR::React$Fragment("x", "y"), dep))
  tag <- div("x", div(), dep, dep2, "z")
  expect_equal(asReactTag(tag), attachDependencies(div("x", div(), "z"), list(dep, dep2)))

  # Nested HTML dependency objects
  tag <- tagList("x", div(dep), span("y"))
  expect_equal(asReactTag(tag), reactR::React$Fragment("x", attachDependencies(div(), dep), span("y")))
  tag <- div("x", tagList(dep), span("y"))
  expect_equal(asReactTag(tag), attachDependencies(div("x", span("y")), dep))

  # HTML dependencies in nested tables
  tbl <- reactable(
    data.frame(x = 1),
    columns = list(x = colDef(cell = function() tagList(dep, dep2)))
  )
  tag <- asReactTag(tbl)
  expect_equal(htmlDependencies(tag), list(dep, dep2))
})

test_that("asReactAttributes", {
  attribs <- list(class = "cls", "for" = "id", tabindex = 1)
  expected <- list(className = "cls", htmlFor = "id", tabIndex = 1)
  expect_equal(asReactAttributes(attribs, "th"), expected)

  attribs <- list(value = "x")
  expect_equal(asReactAttributes(attribs, "input"), list(defaultValue = "x"))
  expect_equal(asReactAttributes(attribs, "select"), list(defaultValue = "x"))
  expect_equal(asReactAttributes(attribs, "textarea"), list(defaultValue = "x"))
  expect_equal(asReactAttributes(attribs, "option"), list(value = "x"))
  expect_equal(asReactAttributes(attribs, "button"), list(value = "x"))

  attribs <- list(checked = NA)
  expect_equal(asReactAttributes(attribs, "input"), list(defaultChecked = TRUE))
  expect_equal(asReactAttributes(attribs, "div"), list(checked = NA))

  attribs <- list(onchange = "onChange(this, event)", onclick = "console.log(this, event);")
  expect_equal(
    asReactAttributes(attribs, "select"),
    list(
      onChange = JS("function(_e){(function(event){onChange(this, event)}).apply(event.target,[_e])}"),
      onClick = JS("function(_e){(function(event){console.log(this, event);}).apply(event.target,[_e])}")
    )
  )

  attribs <- list(style = "border: none; color: red; text-align: left")
  expected <- list(style = list(border = "none", color = "red", "text-align" = "left"))
  expect_equal(asReactAttributes(attribs, "div"), expected)

  attribs <- list(style = list(border = "none"))
  expected <- list(style = list(border = "none"))
  expect_equal(asReactAttributes(attribs, "div"), expected)

  # Non-converted attributes
  expect_equal(asReactAttributes(list("data-attr" = "t"), "div"), list("data-attr" = "t"))
  expect_equal(asReactAttributes(list("aria-label" = "lab"), "div"), list("aria-label" = "lab"))
})

test_that("asReactStyle", {
  expect_equal(asReactStyle("color: red"), list(color = "red"))
  expect_equal(asReactStyle("color: red;"), list(color = "red"))
  expect_equal(asReactStyle("  color: red; margin-bottom:55px ;"),
               list(color = "red", "margin-bottom" = "55px"))
  expect_equal(asReactStyle("  color: red ;; margin-bott"),
               list(color = "red"))
  expect_equal(asReactStyle("color"), list())
  expect_equal(asReactStyle(list(height = 0)), list(height = 0))
})

test_that("trimws", {
  expect_equal(trimws(" "), "")
  expect_equal(trimws("xvz "), "xvz")
  expect_equal(trimws("abd "), "abd")
  expect_equal(trimws("   xvz "), "xvz")
})

test_that("callFunc", {
  expect_equal(callFunc(function(x) x, 5), 5)
  expect_equal(callFunc(function(x) x, 5, "a", "b"), 5)
  expect_equal(callFunc(function(x, y) x + y, 5, 1), 6)
  expect_equal(callFunc(function(x, y) x + y, 5, 1), 6)
  expect_equal(callFunc(function(x) x), NULL)
  expect_equal(callFunc(function(x, y) y, "x"), NULL)
})