skip_on_cran()

test_that("read_redcap works for a classic database with a nonrepeating instrument", {
  # Define partial key columns that should be in a nonrepeating table
  # from a classic database
  expected_present_cols <- c("record_id")
  expected_absent_cols <- c("redcap_form_instance", "redcap_event", "redcap_arm")

  # Pull a nonrepeating table from a classic database
  out <-
    read_redcap(Sys.getenv("REDCAP_URI"), Sys.getenv("REDCAPTIDIER_CLASSIC_API")) %>%
    # suppress expected warning
    suppressWarnings(classes = c(
      "field_missing_categories",
      "empty_parse_warning",
      "duplicate_labels"
    )) %>%
    filter(redcap_form_name == "nonrepeated") %>%
    select(redcap_data) %>%
    pluck(1, 1)

  expect_true(
    all(expected_present_cols %in% names(out))
  )

  expect_false(
    any(expected_absent_cols %in% names(out))
  )
})

test_that("read_redcap works for a classic database with a repeating instrument", {
  # Define partial key columns that should be in a repeating table
  # from a classic database
  expected_present_cols <- c("record_id", "redcap_form_instance")
  expected_absent_cols <- c("redcap_event", "redcap_arm")

  # Pull a repeating table from a classic database
  out <-
    read_redcap(Sys.getenv("REDCAP_URI"), Sys.getenv("REDCAPTIDIER_CLASSIC_API")) %>%
    # suppress expected warning
    suppressWarnings(classes = c(
      "field_missing_categories",
      "empty_parse_warning",
      "duplicate_labels"
    )) %>%
    filter(redcap_form_name == "repeated") %>%
    select(redcap_data) %>%
    pluck(1, 1)

  expect_true(
    all(expected_present_cols %in% names(out))
  )

  expect_false(
    any(expected_absent_cols %in% names(out))
  )
})

test_that("read_redcap returns checkbox fields", {
  # Pull a nonrepeating table from a classic database
  out <-
    read_redcap(Sys.getenv("REDCAP_URI"), Sys.getenv("REDCAPTIDIER_CLASSIC_API")) %>%
    # suppress expected warning
    suppressWarnings(classes = c(
      "field_missing_categories",
      "empty_parse_warning",
      "duplicate_labels"
    )) %>%
    filter(redcap_form_name == "data_field_types") %>%
    select(redcap_data) %>%
    pluck(1, 1)

  expect_true("checkbox_multiple___1" %in% names(out))
})

test_that("supplying forms is equivalent to post-hoc filtering for a classic database", {
  # Explicitly testing form that doesn't contain identifiers
  filtered_by_api <-
    read_redcap(Sys.getenv("REDCAP_URI"),
      Sys.getenv("REDCAPTIDIER_CLASSIC_API"),
      forms = "repeated"
    )

  filtered_locally <-
    read_redcap(
      Sys.getenv("REDCAP_URI"),
      Sys.getenv("REDCAPTIDIER_CLASSIC_API")
    ) %>%
    # suppress expected warning
    suppressWarnings(classes = c(
      "field_missing_categories",
      "empty_parse_warning",
      "duplicate_labels"
    )) %>%
    filter(redcap_form_name == "repeated")

  expect_equal(
    filtered_by_api, filtered_locally
  )
})

test_that("supplying forms is equivalent to post-hoc filtering for a longitudinal database", {
  # Explicitly testing form that doesn't contain identifiers
  filtered_by_api <-
    read_redcap(Sys.getenv("REDCAP_URI"),
      Sys.getenv("REDCAPTIDIER_LONGITUDINAL_API"),
      forms = "repeated"
    )

  filtered_locally <-
    read_redcap(
      Sys.getenv("REDCAP_URI"),
      Sys.getenv("REDCAPTIDIER_LONGITUDINAL_API")
    ) %>%
    filter(redcap_form_name == "repeated")

  expect_equal(
    filtered_by_api, filtered_locally
  )
})

test_that("supplying forms is equivalent to post-hoc filtering for a database with a repeating first instrument", {
  # Explicitly testing form that doesn't contain identifiers
  filtered_by_api <-
    read_redcap(Sys.getenv("REDCAP_URI"),
      Sys.getenv("REDCAPTIDIER_REPEAT_FIRST_INSTRUMENT_API"),
      forms = "form_2"
    )

  filtered_locally <-
    read_redcap(
      Sys.getenv("REDCAP_URI"),
      Sys.getenv("REDCAPTIDIER_REPEAT_FIRST_INSTRUMENT_API")
    ) %>%
    filter(redcap_form_name == "form_2")

  expect_equal(
    filtered_by_api, filtered_locally
  )
})

test_that("read_redcap works for a longitudinal, single arm database with a nonrepeating instrument", {
  # Define partial key columns that should be in a nonrepeating table
  # from a longitudinal, single arm database
  expected_present_cols <- c("record_id", "redcap_event")
  expected_absent_cols <- c("redcap_form_instance", "redcap_arm")

  # Pull a nonrepeating table from a longitudinal, single arm database
  out <-
    read_redcap(Sys.getenv("REDCAP_URI"), Sys.getenv("REDCAPTIDIER_LONGITUDINAL_NOARMS_API")) %>%
    filter(redcap_form_name == "nonrepeated") %>%
    select(redcap_data) %>%
    pluck(1, 1)

  expect_true(
    all(expected_present_cols %in% names(out))
  )

  expect_false(
    any(expected_absent_cols %in% names(out))
  )
})

test_that("read_redcap works for a longitudinal, single arm database with a repeating instrument", {
  # Define partial key columns that should be in a repeating table
  # from a longitudinal, single arm database
  expected_present_cols <- c("record_id", "redcap_form_instance", "redcap_event")
  expected_absent_cols <- c("redcap_arm")

  # Pull a repeating table from a longitudinal, single arm database
  out <-
    read_redcap(Sys.getenv("REDCAP_URI"), Sys.getenv("REDCAPTIDIER_LONGITUDINAL_NOARMS_API")) %>%
    filter(redcap_form_name == "repeated") %>%
    select(redcap_data) %>%
    pluck(1, 1)

  expect_true(
    all(expected_present_cols %in% names(out))
  )

  expect_false(
    any(expected_absent_cols %in% names(out))
  )
})

test_that("read_redcap works for a longitudinal, multi-arm database with a nonrepeating instrument", {
  # Define partial key columns that should be in a nonrepeating table
  # from a longitudinal, multi-arm database
  expected_present_cols <- c("record_id", "redcap_event", "redcap_arm")
  expected_absent_cols <- c("redcap_form_instance")

  # Pull a nonrepeating table from a longitudinal, multi arm database
  out <-
    read_redcap(Sys.getenv("REDCAP_URI"), Sys.getenv("REDCAPTIDIER_LONGITUDINAL_API")) %>%
    filter(redcap_form_name == "nonrepeated") %>%
    select(redcap_data) %>%
    pluck(1, 1)

  expect_true(
    all(expected_present_cols %in% names(out))
  )

  expect_false(
    any(expected_absent_cols %in% names(out))
  )
})

test_that("read_redcap works for a longitudinal, multi-arm database with a repeating instrument", {
  # Define partial key columns that should be in a repeating table
  # from a longitudinal, multi-arm database
  expected_present_cols <- c("record_id", "redcap_form_instance", "redcap_event", "redcap_arm")

  # Pull a repeating table from a longitudinal, multi arm database
  out <-
    read_redcap(Sys.getenv("REDCAP_URI"), Sys.getenv("REDCAPTIDIER_LONGITUDINAL_API")) %>%
    filter(redcap_form_name == "repeated") %>%
    select(redcap_data) %>%
    pluck(1, 1)

  expect_true(
    all(expected_present_cols %in% names(out))
  )
})

test_that("errors when non-existent form is supplied alone", {
  read_redcap(Sys.getenv("REDCAP_URI"),
    Sys.getenv("REDCAPTIDIER_CLASSIC_API"),
    forms = "fake-form"
  ) %>%
    expect_error(class = "form_does_not_exist")
})

test_that("errors when non-existent form is supplied with existing forms", {
  read_redcap(Sys.getenv("REDCAP_URI"),
    Sys.getenv("REDCAPTIDIER_CLASSIC_API"),
    forms = c("fake-form", "repeated")
  ) %>%
    expect_error(class = "form_does_not_exist")
})

test_that("get_fields_to_drop handles checkboxes", {
  # Example metadata
  test_meta <- tibble::tribble(
    ~field_name, ~form_name, ~field_type, ~select_choices_or_calculations, ~field_label,
    "record_id", "my_form", "text", NA_character_, NA_character_,
    "my_checkbox", "my_form", "checkbox", "1, 1 | -99, Unknown", NA_character_
  )

  res <- get_fields_to_drop(test_meta, "my_form")

  expect_setequal(
    res,
    c("my_checkbox___1", "my_checkbox___-99", "my_form_complete")
  )
})

test_that("read_redcap returns metadata", {
  out <- read_redcap(Sys.getenv("REDCAP_URI"), Sys.getenv("REDCAPTIDIER_LONGITUDINAL_API"))

  expected_cols <- c(
    "redcap_form_name", "redcap_form_label", "redcap_data", "redcap_metadata",
    "redcap_events", "structure", "data_rows", "data_cols", "data_size",
    "data_na_pct", "form_complete_pct"
  )

  # metadata fields exist and correctly ordered
  expect_equal(expected_cols, names(out))

  # metadata fields have the correct data types

  ## redcap_metadata and redcap_events fields consist of tibbles
  expect_s3_class(out$redcap_metadata[[1]], "tbl")
  expect_s3_class(out$redcap_events[[1]], "tbl")

  ## summary fields have correct types
  expect_type(out$data_rows, "integer")
  expect_type(out$data_cols, "integer")
  expect_s3_class(out$data_size, "lobstr_bytes")
  expect_true(
    all(out$data_na_pct >= 0) && all(out$data_na_pct <= 100)
  )
  expect_true(
    all(out$form_complete_pct >= 0) && all(out$form_complete_pct <= 100)
  )

  # check that for each tibble in out$redcap_data, all fields in the data are
  # represented in the corresponding tibble in out$redcap_metadata

  ## Some fields we know won't be in the metadata
  exclude_fields <- c(
    "redcap_form_instance", "redcap_event",
    "redcap_arm", "form_status_complete"
  )

  ## map over rows of supertibble and extract fields in metadata from each
  ## instrument
  fields_in_metadata <- out$redcap_metadata %>%
    map(~ .[["field_name"]])

  ## map over rows of supertibble and extract fields in data from each
  ## instrument
  fields_in_data <- out$redcap_data %>%
    map(colnames) %>%
    # remove fields that we don't expected in metadata
    map(setdiff, y = exclude_fields)

  ## make sure metadata fields match data fields for each instrument
  expect_equal(fields_in_metadata, fields_in_data)
})

test_that("read_redcap suppresses events metadata for non-longitudinal database", {
  out <- read_redcap(Sys.getenv("REDCAP_URI"), Sys.getenv("REDCAPTIDIER_CLASSIC_API")) %>%
    suppressWarnings(classes = c(
      "field_missing_categories",
      "empty_parse_warning",
      "duplicate_labels"
    ))

  expect_false("redcap_events" %in% names(out))
})

test_that("read_redcap preserves form_name order mirroring original REDCapR metadata order", {
  expected_order <- REDCapR::redcap_metadata_read(Sys.getenv("REDCAP_URI"),
    Sys.getenv("REDCAPTIDIER_CLASSIC_API"),
    verbose = FALSE
  )$data %>%
    pull(form_name) %>%
    unique()

  out <- read_redcap(Sys.getenv("REDCAP_URI"), Sys.getenv("REDCAPTIDIER_CLASSIC_API")) %>%
    suppressWarnings(classes = c(
      "field_missing_categories",
      "empty_parse_warning",
      "duplicate_labels"
    ))

  expect_equal(expected_order, out$redcap_form_name)
})

test_that("read_redcap returns expected survey fields", {
  out <- read_redcap(Sys.getenv("REDCAP_URI"),
    Sys.getenv("REDCAPTIDIER_CLASSIC_API"),
    export_survey_fields = TRUE
  ) %>%
    suppressWarnings(classes = c(
      "field_missing_categories",
      "empty_parse_warning",
      "duplicate_labels"
    ))

  survey_data <- out$redcap_data[out$redcap_form_name == "survey"][[1]]
  repeat_survey_data <- out$redcap_data[out$redcap_form_name == "repeat_survey"][[1]]

  expected_nonrep_cols <- c("redcap_survey_identifier", "redcap_survey_timestamp")
  expected_rep_cols <- c("redcap_survey_identifier", "redcap_survey_timestamp")

  expect_true(all(expected_nonrep_cols %in% names(survey_data)))
  expect_true(all(expected_rep_cols %in% names(repeat_survey_data)))

  checkmate::expect_class(survey_data$redcap_survey_timestamp, c("POSIXct", "POSIXt"))
})

test_that("read_redcap errors with bad inputs", {
  # Checking for type and length constraints where relevant

  # args missing

  ## TODO

  # redcap uri
  expect_error(read_redcap(123, Sys.getenv("REDCAPTIDIER_CLASSIC_API")), class = "check_character")
  expect_error(read_redcap(letters[1:3], Sys.getenv("REDCAPTIDIER_CLASSIC_API")), class = "check_character")
  expect_error(
    read_redcap("https://www.google.comm", Sys.getenv("REDCAPTIDIER_CLASSIC_API")),
    class = "cannot_resolve_host"
  )

  # token
  expect_error(read_redcap(Sys.getenv("REDCAP_URI"), 123), class = "check_character")
  expect_error(read_redcap(Sys.getenv("REDCAP_URI"), letters[1:3]), class = "check_character")
  expect_error(read_redcap(Sys.getenv("REDCAP_URI"), "abc"), class = "invalid_token")
  expect_error(read_redcap(Sys.getenv("REDCAP_URI"), ""), class = "invalid_token")
  expect_error(
    read_redcap(Sys.getenv("REDCAP_URI"), "CC0CE44238EF65C5DA26A55DD749AF7"), # 31 hex characters
    class = "invalid_token"
  )
  expect_error(
    read_redcap(Sys.getenv("REDCAP_URI"), "CC0CE44238EF65C5DA26A55DD749AF7A"), # will be rejected
    class = "api_token_rejected"
  )

  # raw_or_label
  expect_error(
    read_redcap(Sys.getenv("REDCAP_URI"), Sys.getenv("REDCAPTIDIER_CLASSIC_API"), raw_or_label = "bad option"),
    class = "check_choice"
  )

  # forms
  expect_error(
    read_redcap(Sys.getenv("REDCAP_URI"), Sys.getenv("REDCAPTIDIER_CLASSIC_API"), forms = 123),
    class = "check_character"
  )

  # export_survey_fields
  expect_error(
    read_redcap(Sys.getenv("REDCAP_URI"), Sys.getenv("REDCAPTIDIER_CLASSIC_API"), export_survey_fields = 123),
    class = "check_logical"
  )
  expect_error(
    read_redcap(Sys.getenv("REDCAP_URI"), Sys.getenv("REDCAPTIDIER_CLASSIC_API"), export_survey_fields = c(TRUE, TRUE)),
    class = "check_logical"
  )

  # suppress_redcapr_messages
  expect_error(
    read_redcap(Sys.getenv("REDCAP_URI"), Sys.getenv("REDCAPTIDIER_CLASSIC_API"), suppress_redcapr_messages = 123),
    class = "check_logical"
  )
  expect_error(
    read_redcap(
      Sys.getenv("REDCAP_URI"),
      Sys.getenv("REDCAPTIDIER_CLASSIC_API"),
      suppress_redcapr_messages = c(TRUE, TRUE)
    ),
    class = "check_logical"
  )

  # export_data_access_group
  expect_error(
    read_redcap(Sys.getenv("REDCAP_URI"), Sys.getenv("REDCAPTIDIER_DAG_API"), export_data_access_groups = "TRUE"),
    class = "check_logical"
  )
  expect_error(
    read_redcap(Sys.getenv("REDCAP_URI"), Sys.getenv("REDCAPTIDIER_DAG_API"), export_data_access_groups = 123),
    class = "check_logical"
  )
  expect_error(
    read_redcap(
      Sys.getenv("REDCAP_URI"),
      Sys.getenv("REDCAPTIDIER_DAG_API"),
      export_data_access_groups = c(TRUE, TRUE)
    ),
    class = "check_logical"
  )
})

test_that("read_redcap returns S3 object", {
  out <- read_redcap(Sys.getenv("REDCAP_URI"), Sys.getenv("REDCAPTIDIER_LONGITUDINAL_API"))

  expect_s3_class(out, "redcap_supertbl")
})

test_that("read_redcap handles access restrictions", {
  # Warns due to partial data access
  read_redcap(Sys.getenv("REDCAP_URI"), Sys.getenv("REDCAPTIDIER_RESTRICTED_ACCESS_API")) %>%
    expect_warning(class = "partial_data_access")

  out <- read_redcap(Sys.getenv("REDCAP_URI"), Sys.getenv("REDCAPTIDIER_RESTRICTED_ACCESS_API")) %>%
    suppressWarnings(classes = "redcap_user_rights")

  # Response has expected instruments
  expect_equal(out$redcap_form_name, c("full_access", "remove_phi_access", "deidentify_phi_access"))

  # Errors if only instruments with no access were requested
  read_redcap(Sys.getenv("REDCAP_URI"), Sys.getenv("REDCAPTIDIER_RESTRICTED_ACCESS_API"), forms = "no_access") %>%
    expect_error(class = "no_data_access")
})

test_that("read_redcap returns expected vals from repeating events databases", {
  out <- read_redcap(Sys.getenv("REDCAP_URI"), Sys.getenv("REDCAPTIDIER_REPEATING_EVENT_API"))

  nonrepeat_out <- out %>%
    filter(redcap_form_name == "nr_instrument") %>%
    select(redcap_data) %>%
    pluck(1, 1)

  repeat_out <- out %>%
    filter(redcap_form_name == "r_instrument") %>%
    select(redcap_data) %>%
    pluck(1, 1)

  expected_nonrepeat_cols <- c(
    "record_id",
    "redcap_event",
    "redcap_event_instance",
    "form_status_complete"
  )

  expected_repeat_cols <- c(
    "record_id",
    "redcap_event",
    "redcap_form_instance",
    "form_status_complete"
  )

  expect_true(all(expected_nonrepeat_cols %in% names(nonrepeat_out)))
  expect_s3_class(nonrepeat_out, "tbl")
  expect_true(nrow(nonrepeat_out) > 0)

  expect_true(all(expected_repeat_cols %in% names(repeat_out)))
  expect_s3_class(repeat_out, "tbl")
  expect_true(nrow(repeat_out) > 0)
})

test_that("read_redcap works for a large sparse database", {
  out <- read_redcap(Sys.getenv("REDCAP_URI"), Sys.getenv("REDCAPTIDIER_LARGE_SPARSE_API"))

  expected_col_types <- c(
    "numeric",
    "logical",
    "numeric",
    "logical",
    "Date",
    "factor",
    "factor",
    "character",
    "factor"
  )

  names(expected_col_types) <- c(
    "record_id",
    "empty_int_column",
    "partial_empty_int_column",
    "empty_date_column",
    "partial_empty_date_column",
    "empty_factor_column",
    "partial_empty_factor_column",
    "data_type_switch",
    "form_status_complete"
  )

  out %>%
    extract_tibble("form_1") %>%
    vapply(class, character(1)) %>%
    expect_equal(expected_col_types)

  out_low_max <- read_redcap(Sys.getenv("REDCAP_URI"),
    Sys.getenv("REDCAPTIDIER_LARGE_SPARSE_API"),
    guess_max = 500
  )

  out_low_max %>%
    extract_tibble("form_1") %>%
    vapply(class, character(1)) %>%
    expect_equal(expected_col_types)
})

test_that("read_redcap works with non-longitudinal Data Access Groups", {
  out_dag <- read_redcap(
    Sys.getenv("REDCAP_URI"),
    Sys.getenv("REDCAPTIDIER_DAG_API")
  )

  # Check for expected column and data
  dag_data <- out_dag$redcap_data[[1]]

  expect_true("redcap_data_access_group" %in% names(dag_data))
  expect_true(is.character(dag_data$redcap_data_access_group))
  expect_equal(dag_data$redcap_data_access_group, c("dag1", "dag2", "dag3", NA))

  # Check for expected label
  out_dag_labelled <- out_dag %>% make_labelled()

  dag_label <- labelled::lookfor(out_dag_labelled$redcap_data[[1]])
  dag_label <- dag_label$label[dag_label$variable == "redcap_data_access_group"]

  expect_equal(dag_label, c("redcap_data_access_group" = "REDCap Data Access Group"))
})

test_that("read_redcap works with longitudinal Data Access Groups", {
  out_dag_long <- read_redcap(
    Sys.getenv("REDCAP_URI"),
    Sys.getenv("REDCAPTIDIER_LONGITUDINAL_DAG_API")
  )

  # Check for expected column and data
  dag_data_long <- out_dag_long$redcap_data[[1]]

  expect_true("redcap_data_access_group" %in% names(dag_data_long))
  expect_true(is.character(dag_data_long$redcap_data_access_group))
  expect_equal(dag_data_long$redcap_data_access_group, c("dag1", "dag1", "dag2", "dag2", "dag3"))

  # Check for expected label
  out_dag_long_labelled <- out_dag_long %>% make_labelled()

  dag_label_long <- labelled::lookfor(out_dag_long_labelled$redcap_data[[1]])
  dag_label_long <- dag_label_long$label[dag_label_long$variable == "redcap_data_access_group"]

  expect_equal(dag_label_long, c("redcap_data_access_group" = "REDCap Data Access Group"))
})

test_that("read_redcap doesn't return the redcap_data_access_group column for non DAG databases", {
  out_no_dag <- read_redcap(
    Sys.getenv("REDCAP_URI"),
    Sys.getenv("REDCAPTIDIER_CLASSIC_API")
  ) %>%
    # suppress expected warning
    suppressWarnings(classes = c(
      "field_missing_categories",
      "empty_parse_warning",
      "duplicate_labels"
    ))

  # retrieve all names from all redcap_data list elements
  no_dag_all_names <- lapply(out_no_dag$redcap_data, names) %>% unlist()
  expect_true(!"redcap_data_access_group" %in% no_dag_all_names)
})

test_that("read_redcap fails if DAG or survey columns are explicitly requested but don't exist", {
  expect_error(
    out_no_dag <- read_redcap(Sys.getenv("REDCAP_URI"),
      Sys.getenv("REDCAPTIDIER_CLASSIC_API"),
      export_data_access_groups = TRUE
    ),
    class = "nonexistent_arg_requested"
  )

  expect_error(
    out_no_dag <- read_redcap(Sys.getenv("REDCAP_URI"),
      Sys.getenv("REDCAPTIDIER_DAG_API"),
      export_survey_fields = TRUE
    ),
    class = "nonexistent_arg_requested"
  )
})

test_that("read_redcap handles missing data codes", {
  out <- read_redcap(Sys.getenv("REDCAP_URI"), Sys.getenv("REDCAPTIDIER_MDC_API")) |>
    suppressWarnings(classes = c("field_is_logical", "extra_field_values")) |>
    extract_tibble("form_1")

  # logicals are not converted to NA
  expect_type(out$yesno, "logical")
  expect_true(!all(is.na(out$yesno)))
  # categoricals remove missing data codes
  expect_factor(out$dropdown)
  expect_true(all(is.na(out$dropdown) | out$dropdown != "UNK"))

  withr::with_options(list(redcaptidier.allow.mdc = TRUE), {
    read_redcap(Sys.getenv("REDCAP_URI"), Sys.getenv("REDCAPTIDIER_MDC_API"))
  }) |>
    expect_no_warning()
})