library(testthat)
library(DataAudit)

test_that("audit_rules returns correct class", {

  rules <- audit_rules()

  expect_s3_class(
    rules,
    "DataAuditRules"
  )

  expect_type(
    rules,
    "list"
  )
})


test_that("audit_rules has expected components", {

  rules <- audit_rules()

  expect_equal(
    names(rules),
    c(
      "range",
      "category",
      "unique",
      "required",
      "pattern"
    )
  )
})


test_that("empty rules are allowed", {

  rules <- audit_rules()

  expect_true(
    all(
      vapply(
        rules,
        is.null,
        logical(1)
      )
    )
  )
})


test_that("valid range rules are accepted", {

  expect_no_error(
    audit_rules(
      range = list(
        Age = c(0, 30),
        Weight = c(1, 100)
      )
    )
  )
})


test_that("range must be named list", {

  expect_error(
    audit_rules(
      range = c(0, 10)
    ),
    "'range' must be a named list or NULL"
  )

  expect_error(
    audit_rules(
      range = list(
        c(0, 10)
      )
    ),
    "'range' must be a named list with non-empty names"
  )
})


test_that("range names cannot be duplicated", {

  x <- list(
    c(0, 10),
    c(0, 20)
  )

  names(x) <- c(
    "Age",
    "Age"
  )

  expect_error(
    audit_rules(
      range = x
    ),
    "'range' contains duplicated variable names"
  )
})


test_that("range limits must be numeric length two", {

  expect_error(
    audit_rules(
      range = list(
        Age = 10
      )
    ),
    "must contain two finite numeric values"
  )

  expect_error(
    audit_rules(
      range = list(
        Age = c(
          "0",
          "10"
        )
      )
    ),
    "must contain two finite numeric values"
  )

  expect_error(
    audit_rules(
      range = list(
        Age = c(
          0,
          NA
        )
      )
    ),
    "must contain two finite numeric values"
  )

  expect_error(
    audit_rules(
      range = list(
        Age = c(
          0,
          Inf
        )
      )
    ),
    "must contain two finite numeric values"
  )
})


test_that("range minimum cannot exceed maximum", {

  expect_error(
    audit_rules(
      range = list(
        Age = c(
          30,
          0
        )
      )
    ),
    "Minimum range value cannot exceed maximum"
  )
})


test_that("valid category rules are accepted", {

  expect_no_error(
    audit_rules(
      category = list(
        Species = c(
          "Dog",
          "Cat",
          "Cattle"
        )
      )
    )
  )
})


test_that("category must be named list", {

  expect_error(
    audit_rules(
      category = c(
        "Dog",
        "Cat"
      )
    ),
    "'category' must be a named list or NULL"
  )

  expect_error(
    audit_rules(
      category = list(
        c(
          "Dog",
          "Cat"
        )
      )
    ),
    "'category' must be a named list with non-empty names"
  )
})


test_that("category rules must contain atomic values", {

  expect_error(
    audit_rules(
      category = list(
        Species = list(
          "Dog",
          "Cat"
        )
      )
    ),
    "must contain a non-empty atomic vector"
  )

  expect_error(
    audit_rules(
      category = list(
        Species = character()
      )
    ),
    "must contain a non-empty atomic vector"
  )
})


test_that("category values cannot contain missing values", {

  expect_error(
    audit_rules(
      category = list(
        Species = c(
          "Dog",
          NA
        )
      )
    ),
    "cannot contain missing values"
  )
})


test_that("unique variables are accepted", {

  expect_no_error(
    audit_rules(
      unique = c(
        "Animal_ID",
        "Sample_ID"
      )
    )
  )
})


test_that("required variables are accepted", {

  expect_no_error(
    audit_rules(
      required = c(
        "Animal_ID",
        "Species"
      )
    )
  )
})


test_that("unique must contain valid variable names", {

  expect_error(
    audit_rules(
      unique = 1
    ),
    "'unique' must be a character vector"
  )

  expect_error(
    audit_rules(
      unique = c(
        "ID",
        NA
      )
    ),
    "'unique' must be a character vector"
  )

  expect_error(
    audit_rules(
      unique = c(
        "ID",
        ""
      )
    ),
    "'unique' must be a character vector"
  )
})


test_that("required must contain valid variable names", {

  expect_error(
    audit_rules(
      required = 1
    ),
    "'required' must be a character vector"
  )

  expect_error(
    audit_rules(
      required = NA_character_
    ),
    "'required' must be a character vector"
  )
})


test_that("duplicated unique variables are rejected", {

  expect_error(
    audit_rules(
      unique = c(
        "ID",
        "ID"
      )
    ),
    "'unique' contains duplicated variable names"
  )
})


test_that("duplicated required variables are rejected", {

  expect_error(
    audit_rules(
      required = c(
        "Species",
        "Species"
      )
    ),
    "'required' contains duplicated variable names"
  )
})


test_that("valid pattern rules are accepted", {

  expect_no_error(
    audit_rules(
      pattern = list(
        Animal_ID =
          "^A[0-9]+$"
      )
    )
  )
})


test_that("pattern must be named list", {

  expect_error(
    audit_rules(
      pattern = "^A"
    ),
    "'pattern' must be a named list or NULL"
  )

  expect_error(
    audit_rules(
      pattern = list(
        "^A"
      )
    ),
    "'pattern' must be a named list with non-empty names"
  )
})


test_that("pattern must contain scalar strings", {

  expect_error(
    audit_rules(
      pattern = list(
        ID = 1
      )
    ),
    "must be a single non-empty character string"
  )

  expect_error(
    audit_rules(
      pattern = list(
        ID = ""
      )
    ),
    "must be a single non-empty character string"
  )

  expect_error(
    audit_rules(
      pattern = list(
        ID = c(
          "^A",
          "^B"
        )
      )
    ),
    "must be a single non-empty character string"
  )
})


test_that("invalid regular expression is rejected without warning", {

  expect_error(
    audit_rules(
      pattern = list(
        ID = "["
      )
    ),
    "is not a valid regular expression"
  )
})


test_that("all rule types can be combined", {

  rules <- audit_rules(
    range = list(
      Age = c(
        0,
        30
      )
    ),
    category = list(
      Species = c(
        "Dog",
        "Cat"
      )
    ),
    unique = "Animal_ID",
    required = c(
      "Animal_ID",
      "Species"
    ),
    pattern = list(
      Animal_ID =
        "^A[0-9]+$"
    )
  )

  expect_equal(
    rules$range$Age,
    c(0, 30)
  )

  expect_equal(
    rules$category$Species,
    c(
      "Dog",
      "Cat"
    )
  )

  expect_equal(
    rules$unique,
    "Animal_ID"
  )

  expect_equal(
    rules$required,
    c(
      "Animal_ID",
      "Species"
    )
  )

  expect_equal(
    rules$pattern$Animal_ID,
    "^A[0-9]+$"
  )
})


test_that("empty named lists are accepted", {

  expect_no_error(
    audit_rules(
      range = list(),
      category = list(),
      pattern = list()
    )
  )
})
