tests/testthat/test-packs.R

In ruler: Tidy Data Validation Reports

context("packs")


# Input data --------------------------------------------------------------
input <- list(1, dot2 = "a", mean, list(new = 2, 3))

compute_output_ref <- function(.extra_class) {
  list(
    structure(1, class = c(.extra_class, "rule_pack", "numeric")),
    dot2 = structure("a", class = c(.extra_class, "rule_pack", "character")),
    structure(mean, class = c(.extra_class, "rule_pack", "function")),
    new = structure(2, class = c(.extra_class, "rule_pack", "numeric")),
    structure(3, class = c(.extra_class, "rule_pack", "numeric"))
  )
}


# data_packs --------------------------------------------------------------
test_that("data_packs works", {
  output <- data_packs(!!!input)
  output_ref <- compute_output_ref(.extra_class = "data_pack")

  expect_identical(output, output_ref)
})


# group_packs -------------------------------------------------------------
test_that("group_packs works", {
  output_1 <- group_packs(!!!input, .group_vars = c("x", "y"))
  output_2 <- group_packs(
    !!!input,
    .group_vars = c("x", "y"),
    .group_sep = "+"
  )
  output_ref <- compute_output_ref(.extra_class = "group_pack") %>%
    lapply(`attr<-`, which = "group_vars", value = c("x", "y"))
  output_ref_1 <- lapply(output_ref, `attr<-`, which = "group_sep", value = ".")
  output_ref_2 <- lapply(output_ref, `attr<-`, which = "group_sep", value = "+")

  expect_identical(output_1, output_ref_1)
  expect_identical(output_2, output_ref_2)
})

test_that("group_packs throws errors", {
  expect_error(group_packs(!!!input, .group_vars = character(0)))
  expect_error(group_packs(!!!input, .group_vars = 1:2))

  expect_error(group_packs(!!!input, .group_vars = "a", .group_sep = 1))
  expect_error(
    group_packs(!!!input, .group_vars = "a", .group_sep = c("+", "-"))
  )
})


# col_packs ---------------------------------------------------------------
test_that("col_packs works", {
  output <- col_packs(!!!input)
  output_ref <- compute_output_ref(.extra_class = "col_pack")

  expect_identical(output, output_ref)
})


# row_packs ---------------------------------------------------------------
test_that("row_packs works", {
  output <- row_packs(!!!input)
  output_ref <- compute_output_ref(.extra_class = "row_pack")

  expect_identical(output, output_ref)
})


# cell_packs --------------------------------------------------------------
test_that("cell_packs works", {
  output <- cell_packs(!!!input)
  output_ref <- compute_output_ref(.extra_class = "cell_pack")

  expect_identical(output, output_ref)
})


# squash_dots_rule_pack ---------------------------------------------------
test_that("squash_dots_rule_pack returns a list", {
  output <- squash_dots_rule_pack(1, .extra_class = "extra")
  names(output) <- NULL
  output_ref <- list(structure(1, class = c("extra", "rule_pack", "numeric")))

  expect_identical(output, output_ref)
})

test_that("squash_dots_rule_pack returns a named list", {
  output <- squash_dots_rule_pack(!!!input[1:3], .extra_class = "extra")
  output_ref <- compute_output_ref(.extra_class = "extra")[1:3]

  expect_identical(output, output_ref)
})

test_that("squash_dots_rule_pack squashes", {
  output <- squash_dots_rule_pack(
    list(list(1L), list(2L, list(3L))),
    list(list(list(4L)), list(5L, list(6L))),
    .extra_class = "extra"
  )
  names(output) <- NULL
  output_ref <- lapply(
    1:6,
    structure,
    class = c("extra", "rule_pack", "integer")
  )

  expect_identical(output, output_ref)
})


# print.data_pack ---------------------------------------------------------
test_that("print.data_pack works", {
  expect_output(print(data_packs(!!!input)[[1]]), "Data.*ule.*ack")
})


# print.group_pack --------------------------------------------------------
test_that("print.group_pack works", {
  expect_output(
    print(group_packs(!!!input, .group_vars = "a")[[1]]),
    "Group.*ule.*ack"
  )
})


# print.col_pack ----------------------------------------------------------
test_that("print.col_pack works", {
  expect_output(print(col_packs(!!!input)[[1]]), "Column.*ule.*ack")
})


# print.row_pack ----------------------------------------------------------
test_that("print.row_pack works", {
  expect_output(print(row_packs(!!!input)[[1]]), "Row.*ule.*ack")
})


# print.cell_pack ---------------------------------------------------------
test_that("print.cell_pack works", {
  expect_output(print(cell_packs(!!!input)[[1]]), "Cell.*ule.*ack")
})