
# Run this file with testthat::test_local(filter = "^relational$")

con <- local_con()

test_that("we can create a relation from a df", {
  rel <- rel_from_df(con, data.frame(a = 1))
  expect_type(rel, "externalptr")
  expect_s3_class(rel, "duckdb_relation")
})

test_that("we don't add optional quotes to columns", {
  df1 <- data.frame(a.b = 1)
  rel3 <- rel_from_df(con, df1)
  rel4 <- rel_project(rel3, list(expr_reference("a.b")))
  rel5 <- rel_to_altrep(rel4)
  expect_equal(df1, rel5)
})

test_that("we won't crash when creating a relation from odd things", {
  # na seems to be fine, single col data frame with a single row with NA in it
  rel_from_df(con, NA)

  expect_error(rel_from_df(NULL, NULL))
  expect_error(rel_from_df(con, NULL))

  expect_true(TRUE)
})

test_that("we can round-trip a data frame", {
  expect_equal(
    data.frame(a = 1:3, b = letters[1:3]),
    as.data.frame.duckdb_relation(rel_from_df(con, data.frame(a = 1:3, b = letters[1:3]))),
    ignore_attr = TRUE
  )
})

test_that("we can recognize if a df is materialized", {
  expect_error(df_is_materialized(data.frame(a = "x")))
  expect_error(df_is_materialized(data.frame(a = 1:2)))

  rel <- rel_from_df(con, data.frame(a = 1:3))
  df <- rel_to_altrep(rel)
  expect_false(df_is_materialized(df))
  # Side effect: materialization
  expect_equal(nrow(df), 3)
  expect_true(df_is_materialized(df))
})


test_that("we can create various expressions and don't crash", {
  expect_snapshot({
    expr_reference("asdf")
    expr_constant("asdf")
  })

  expect_error(expr_reference(NA))
  #  expect_error(expr_reference(as.character(NA)))
  expect_error(expr_reference(""))
  expect_error(expr_reference(NULL))

  expr_constant(TRUE)
  expr_constant(FALSE)
  expr_constant(NA)
  expr_constant(42L)
  expr_constant(42)

  expect_error(expr_constant(NULL))
  expect_error(expr_constant())


  expr_function("asdf", list())

  expect_error(expr_function("", list()))
  #  expect_error(expr_function(as.character(NA), list()))
  expect_error(expr_function(NULL, list()))
  expect_error(expr_function("asdf"))

  expect_true(TRUE)
})

test_that("we can create comparison expressions with appropriate operators", {
  local_edition(3)

  expect_snapshot({
    expr_comparison("=", list(expr_constant(-42), expr_constant(42L)))
  })
  expect_snapshot({
    expr_comparison("!=", list(expr_constant(-42), expr_constant(42L)))
  })
  expect_snapshot({
    expr_comparison(">", list(expr_constant(-42), expr_constant(42L)))
  })
  expect_snapshot({
    expr_comparison("<", list(expr_constant(-42), expr_constant(42L)))
  })
  expect_snapshot({
    expr_comparison(">=", list(expr_constant(-42), expr_constant(42L)))
  })
  expect_snapshot({
    expr_comparison("<=", list(expr_constant(-42), expr_constant(42L)))
  })
  expect_true(TRUE)
})

test_that("we cannot create comparison expressions with inappropriate operators", {
  local_edition(3)
  withr::local_envvar(NO_COLOR = "true")

  expect_snapshot(error = TRUE, {
    expr_comparison("z", list(expr_constant(-42), expr_constant(42L)))
  })
  expect_snapshot(error = TRUE, {
    expr_comparison("2", list(expr_constant(-42), expr_constant(42L)))
  })
  expect_snapshot(error = TRUE, {
    expr_comparison("-", list(expr_constant(-42), expr_constant(42L)))
  })
})

test_that("we can create operator expressions", {
  local_edition(3)
  withr::local_envvar(NO_COLOR = "true")

  # IN operator with multiple values
  expect_snapshot({
    expr_operator("IN", list(expr_reference("some_column"), expr_constant(-42), expr_constant(42)))
  })

  # NOT IN operator with multiple values
  expect_snapshot({
    expr_operator("NOT IN", list(expr_reference("some_column"), expr_constant(-42), expr_constant(42)))
  })

  # BOGUS operator
  expect_snapshot(error = TRUE, {
    expr_operator("BOGUS", list(expr_reference("some_column"), expr_constant(-42), expr_constant(42)))
  })
})

test_that("we can use operator expressions in relations", {
  df <- data.frame(
    id = 1:5,
    value = c(10, 20, 30, 40, 50)
  )

  rel <- rel_from_df(con, df)

  # Filter using IN operator
  rel_filtered <- rel_filter(
    rel,
    list(expr_operator("IN", list(expr_reference("id"), expr_constant(2L), expr_constant(4L))))
  )
  result <- as.data.frame(rel_filtered)
  expect_equal(result$id, c(2L, 4L))
  expect_equal(result$value, c(20, 40))

  # Filter using NOT IN operator
  rel_filtered <- rel_filter(
    rel,
    list(expr_operator("NOT IN", list(expr_reference("id"), expr_constant(2L), expr_constant(4L), expr_constant(5L))))
  )
  result <- as.data.frame(rel_filtered)
  expect_equal(result$id, c(1L, 3L))
  expect_equal(result$value, c(10, 30))
})

test_that("expr_operator validates ... parameter", {
  expect_error(
    expr_operator("IN", list(expr_reference("col")), extra_param = "value"),
    "... must be empty"
  )
})


# TODO should maybe be a different file, test_enum_strings.R

test_that("we can cast R strings to DuckDB strings", {
  chars <- c(letters, LETTERS)
  max_len <- 100
  n <- 100000

  # yay R one-liners
  gen_rand_string <- function(x, max_len) paste0(chars[sample(1:length(chars), runif(1) * max_len, replace = TRUE)], collapse = "")

  test_string_vec <- c(vapply(1:n, gen_rand_string, "character", max_len), NA, NA, NA, NA, NA, NA, NA, NA) # batman

  df <- data.frame(s = test_string_vec, stringsAsFactors = FALSE)
  expect_equal(df, as.data.frame.duckdb_relation(rel_from_df(con, df)), ignore_attr = TRUE)

  res <- rel_sql(
    rel_from_df(con, df),
    "SELECT s::string FROM _"
  )
  expect_equal(df, res, ignore_attr = TRUE)

  res <- rel_sql(
    rel_from_df(con, df),
    "SELECT COUNT(*) c FROM _"
  )
  expect_equal(nrow(df), res$c)

  # many rounds yay
  df2 <- df
  for (i in 1:10) {
    df2 <- as.data.frame.duckdb_relation(rel_from_df(con, df2))
    expect_equal(df, df2, ignore_attr = TRUE)
  }

  df2 <- df
  for (i in 1:10) {
    df2 <- as.data.frame(
      rel_sql(
        rel_from_df(con, df2),
        "SELECT s::string s FROM _"
      )
    )
    expect_equal(df, df2, ignore_attr = TRUE)
  }
})

test_that("the altrep-conversion for relations works", {
  local_edition(3)

  n_callback <- 0
  last_rel <- NULL
  rlang::local_options(duckdb.materialize_callback = function(rel) {
    n_callback <<- n_callback + 1
    last_rel <<- rel
  })

  iris$Species <- as.character(iris$Species)
  rel <- rel_from_df(con, iris)
  df <- rel_to_altrep(rel)
  expect_false(df_is_materialized(df))
  inspect_output <- capture.output(.Internal(inspect(df)))
  expect_true(any(grepl("DUCKDB_ALTREP_REL_VECTOR", inspect_output, fixed = TRUE)))
  expect_true(any(grepl("DUCKDB_ALTREP_REL_ROWNAMES", inspect_output, fixed = TRUE)))
  expect_false(df_is_materialized(df))
  expect_equal(n_callback, 0)
  dim(df)
  expect_true(df_is_materialized(df))

  expect_snapshot(transform = function(x) gsub("0x[0-9a-f]+", "0x...", x), {
    last_rel
  })

  expect_equal(n_callback, 1)
  expect_equal(iris, df)
})

test_that("ALTREP row names are materialized as integer sequence", {
  df <- data.frame(a = 1:5, b = letters[1:5])
  rel <- rel_from_df(con, df)
  altrep_df <- rel_to_altrep(rel)

  rn <- attr(altrep_df, "row.names")
  expect_identical(rn, 1:5)
})

test_that("ALTREP row names remain ALTREP after duplication", {
  df <- data.frame(a = 1:5, b = letters[1:5])
  rel <- rel_from_df(con, df)
  altrep_df <- rel_to_altrep(rel)

  rn <- attr(altrep_df, "row.names")

  # Check that the row names are ALTREP before duplication
  inspect_before <- capture.output(.Internal(inspect(rn)))
  expect_true(any(grepl("DUCKDB_ALTREP_REL_ROWNAMES", inspect_before, fixed = TRUE)))

  # Trigger duplication by modifying a copy (copy-on-modify semantics)
  rn_dup <- rn
  rn_dup[1L] <- rn_dup[1L]

  # Check that the duplicated row names are still ALTREP
  inspect_after <- capture.output(.Internal(inspect(rn_dup)))
  expect_true(any(grepl("DUCKDB_ALTREP_REL_ROWNAMES", inspect_after, fixed = TRUE)))

  # Verify the values are correct after duplication
  expect_identical(rn_dup, 1:5)
})

test_that("Duplicated ALTREP row names stay ALTREP after a value-changing edit", {
  df <- data.frame(a = 1:5, b = letters[1:5])
  rel <- rel_from_df(con, df)
  altrep_df <- rel_to_altrep(rel)

  rn <- attr(altrep_df, "row.names")
  rn_dup <- rn
  rn_dup[1L] <- 999L

  inspect_after <- capture.output(.Internal(inspect(rn_dup)))
  expect_true(any(grepl("DUCKDB_ALTREP_REL_ROWNAMES", inspect_after, fixed = TRUE)))

  expect_identical(rn_dup, c(999L, 2L, 3L, 4L, 5L))
  expect_identical(rn, 1:5)
})

test_that("ALTREP row names survive repeated duplications", {
  df <- data.frame(a = 1:5)
  rel <- rel_from_df(con, df)
  altrep_df <- rel_to_altrep(rel)

  rn <- attr(altrep_df, "row.names")

  rn_dup1 <- rn
  rn_dup1[1L] <- rn_dup1[1L]

  rn_dup2 <- rn_dup1
  rn_dup2[1L] <- rn_dup2[1L]

  inspect_out1 <- capture.output(.Internal(inspect(rn_dup1)))
  expect_true(any(grepl("DUCKDB_ALTREP_REL_ROWNAMES", inspect_out1, fixed = TRUE)))

  inspect_out2 <- capture.output(.Internal(inspect(rn_dup2)))
  expect_true(any(grepl("DUCKDB_ALTREP_REL_ROWNAMES", inspect_out2, fixed = TRUE)))

  expect_identical(rn_dup1, 1:5)
  expect_identical(rn_dup2, 1:5)
})

test_that("ALTREP row names of larger relations remain ALTREP after duplication", {
  df <- data.frame(a = 1:1000)
  rel <- rel_from_df(con, df)
  altrep_df <- rel_to_altrep(rel)

  rn <- attr(altrep_df, "row.names")
  rn_dup <- rn
  rn_dup[1L] <- rn_dup[1L]

  inspect_out <- capture.output(.Internal(inspect(rn_dup)))
  expect_true(any(grepl("DUCKDB_ALTREP_REL_ROWNAMES", inspect_out, fixed = TRUE)))

  expect_identical(rn_dup, 1:1000)
})

test_that("the altrep-conversion for relations work for weirdo types for strict = FALSE", {
  test_df <- data.frame(
    col_date = as.Date("2019-11-26"),
    col_ts = as.POSIXct("2019-11-26 21:11Z", tz = "UTC"),
    col_factor = factor(c("a"))
  )
  rel <- rel_from_df(con, test_df, strict = FALSE)
  df <- rel_to_altrep(rel)
  expect_false(df_is_materialized(df))
  expect_equal(test_df, df)
})

test_that("we can get the relation object back from an altrep df", {
  iris$Species <- as.character(iris$Species)
  rel <- rel_from_df(con, iris)
  df <- rel_to_altrep(rel)
  rel2 <- rel_from_altrep_df(df)
  expect_true(TRUE)
})

test_that("rel_order() sorts NAs last", {
  test_df <- rel_from_df(con, data.frame(a = c(NA, 1:3)))

  orders <- list(expr_reference("a"))

  rel <- rel_order(test_df, orders)
  rel_df <- rel_to_altrep(rel)
  expect_false(df_is_materialized(rel_df))

  expected_result <- data.frame(a = c(1:3, NA))
  expect_equal(rel_df, expected_result)
})

test_that("Inner join returns all inner relations", {
  dbExecute(con, "CREATE OR REPLACE MACRO eq(a, b) AS a = b")
  left <- rel_from_df(con, data.frame(left_a = c(1, 2, 3), left_b = c(1, 1, 2)))
  right <- rel_from_df(con, data.frame(right_b = c(1, 3), right_c = c(4, 5)))
  cond <- list(expr_function("eq", list(expr_reference("left_b"), expr_reference("right_b"))))
  rel2 <- rel_join(left, right, cond, "inner")
  rel_df <- rel_to_altrep(rel2)
  dim(rel_df)
  expected_result <- data.frame(left_a = c(1, 2), left_b = c(1, 1), right_b = c(1, 1), right_c = c(4, 4))
  expect_equal(rel_df, expected_result)
})

test_that("Left join returns all left relations", {
  dbExecute(con, "CREATE OR REPLACE MACRO eq(a, b) AS a = b")
  left <- rel_from_df(con, data.frame(left_a = c(1, 2, 3), left_b = c(1, 1, 2)))
  right <- rel_from_df(con, data.frame(right_b = c(1)))
  cond <- list(expr_function("eq", list(expr_reference("left_b"), expr_reference("right_b"))))
  rel2 <- rel_join(left, right, cond, "left")
  rel_df <- rel_to_altrep(rel2)
  dim(rel_df)
  expected_result <- data.frame(left_a = c(1, 2, 3), left_b = c(1, 1, 2), right_b = c(1, 1, NA))
  expect_equal(rel_df, expected_result)
})

test_that("Right join returns all right relations", {
  dbExecute(con, "CREATE OR REPLACE MACRO eq(a, b) AS a = b")
  left <- rel_from_df(con, data.frame(left_b = c(1)))
  right <- rel_from_df(con, data.frame(right_a = c(1, 2, 3), right_b = c(1, 1, 2)))
  cond <- list(expr_function("eq", list(expr_reference("left_b"), expr_reference("right_b"))))
  rel2 <- rel_join(left, right, cond, "right")
  rel_df <- rel_to_altrep(rel2)
  dim(rel_df)
  expected_result <- data.frame(left_b = c(1, 1, NA), right_a = c(1, 2, 3), right_b = c(1, 1, 2))
  expect_equal(rel_df, expected_result)
})

test_that("Full join returns all outer relations", {
  dbExecute(con, "CREATE OR REPLACE MACRO eq(a, b) AS a = b")
  left <- rel_from_df(con, data.frame(left_a = c(1, 2, 5), left_b = c(4, 5, 6)))
  right <- rel_from_df(con, data.frame(right_a = c(1, 2, 3), right_b = c(1, 1, 2)))
  cond <- list(expr_function("eq", list(expr_reference("left_a"), expr_reference("right_a"))))
  rel2 <- rel_join(left, right, cond, "outer")
  rel_df <- rel_to_altrep(rel2)

  expected_result <- data.frame(
    left_a = c(1, 2, 5, NA),
    left_b = c(4, 5, 6, NA),
    right_a = c(1, 2, NA, 3),
    right_b = c(1, 1, NA, 2)
  )

  rel_df_sorted <- rel_df[order(rel_df$left_a), ]
  rownames(rel_df_sorted) <- NULL
  expect_equal(rel_df_sorted, expected_result)
})

test_that("cross join works", {
  left <- rel_from_df(con, data.frame(left_a = c(1, 2, 3), left_b = c(1, 1, 2)))
  right <- rel_from_df(con, data.frame(right_a = c(1, 4, 5), right_b = c(7, 8, 9)))
  cross <- rel_join(left, right, list(), "cross")
  order_by <- rel_order(cross, list(expr_reference("right_a"), expr_reference("right_a")))
  rel_df <- rel_to_altrep(order_by)
  dim(rel_df)
  expected_result <- data.frame(
    left_a = c(1, 2, 3, 1, 2, 3, 1, 2, 3),
    left_b = c(1, 1, 2, 1, 1, 2, 1, 1, 2),
    right_a = c(1, 1, 1, 4, 4, 4, 5, 5, 5),
    right_b = c(7, 7, 7, 8, 8, 8, 9, 9, 9)
  )
  expect_equal(rel_df, expected_result)
})

test_that("semi join works", {
  left <- rel_from_df(con, data.frame(left_b = c(1, 5, 6)))
  right <- rel_from_df(con, data.frame(right_a = c(1, 2, 3), right_b = c(1, 1, 2)))
  cond <- list(expr_function("eq", list(expr_reference("left_b"), expr_reference("right_a"))))
  # select * from left semi join right on (left_b = right_a)
  rel2 <- rel_join(left, right, cond, "semi")
  rel_df <- rel_to_altrep(rel2)
  dim(rel_df)
  expected_result <- data.frame(left_b = c(1))
  expect_equal(rel_df, expected_result)

})

test_that("anti join works", {
  left <- rel_from_df(con, data.frame(left_b = c(1, 5, 6)))
  right <- rel_from_df(con, data.frame(right_a = c(1, 2, 3), right_b = c(1, 1, 2)))
  cond <- list(expr_function("eq", list(expr_reference("left_b"), expr_reference("right_a"))))
  # select * from left anti join right on (left_b = right_a)
  rel2 <- rel_join(left, right, cond, "anti")
  rel_df <- rel_to_altrep(rel2)
  dim(rel_df)
  expected_result <- data.frame(left_b = c(5, 6))
  expect_equal(rel_df, expected_result)
})

test_that("Union all does not immediately materialize", {
  test_df_a <- rel_from_df(con, data.frame(a = c("1", "2"), b = c("3", "4")))
  test_df_b <- rel_from_df(con, data.frame(a = c("5", "6"), b = c("7", "8")))
  rel <- rel_union_all(test_df_a, test_df_b)
  rel_df <- rel_to_altrep(rel)
  expect_false(df_is_materialized(rel_df))
  dim(rel_df)
  expect_true(df_is_materialized(rel_df))
})

test_that("Union all has the correct values", {
  test_df_a <- rel_from_df(con, data.frame(a = c("1", "2"), b = c("3", "4")))
  test_df_b <- rel_from_df(con, data.frame(a = c("5", "6"), b = c("7", "8")))
  rel <- rel_union_all(test_df_a, test_df_b)
  order_by_rel <- rel_order(rel, list(expr_reference("a"), expr_reference("b")))
  rel_df <- rel_to_altrep(order_by_rel)
  expect_false(df_is_materialized(rel_df))
  dim(rel_df)
  expect_true(df_is_materialized(rel_df))
  expected_result <- data.frame(a = c("1", "2", "5", "6"), b = c("3", "4", "7", "8"))
  expect_equal(rel_df, expected_result)
})

test_that("Union all keeps duplicates", {
  test_df_a2 <- rel_from_df(con, data.frame(a = c("1", "2"), b = c("3", "4")))
  test_df_b2 <- rel_from_df(con, data.frame(a = c("1", "2"), b = c("3", "4")))
  rel <- rel_union_all(test_df_a2, test_df_b2)
  order_by_rel <- rel_order(rel, list(expr_reference("a"), expr_reference("b")))
  rel_df <- rel_to_altrep(order_by_rel)
  dim(rel_df)
  expect_true(df_is_materialized(rel_df))
  expected_result <- data.frame(a = c("1", "1", "2", "2"), b = c("3", "3", "4", "4"))
  expect_equal(rel_df, expected_result)
})

test_that("Inner join returns all inner relations", {
  dbExecute(con, "CREATE OR REPLACE MACRO eq(a, b) AS a = b")
  left <- rel_from_df(con, data.frame(left_a = c(1, 2, 3), left_b = c(1, 1, 2)))
  right <- rel_from_df(con, data.frame(right_b = c(1, 3), right_c = c(4, 5)))
  cond <- list(expr_function("eq", list(expr_reference("left_b"), expr_reference("right_b"))))
  rel2 <- rel_join(left, right, cond, "inner")
  rel_df <- rel_to_altrep(rel2)
  dim(rel_df)
  expected_result <- data.frame(left_a = c(1, 2), left_b = c(1, 1), right_b = c(1, 1), right_c = c(4, 4))
  expect_equal(rel_df, expected_result)
})

test_that("ASOF join works", {
  dbExecute(con, "CREATE OR REPLACE MACRO gte(a, b) AS a >= b")
  test_df1 <- rel_from_df(con, data.frame(ts = c(1, 2, 3, 4, 5, 6, 7, 8, 9)))
  test_df2 <- rel_from_df(con, data.frame(event_ts = c(1, 3, 6, 8), event_id = c(0, 1, 2, 3)))
  cond <- list(expr_function("gte", list(expr_reference("ts"), expr_reference("event_ts"))))
  rel <- rel_join(test_df1, test_df2, cond, join_ref_type = "asof")
  rel_proj <- rel_project(rel, list(expr_reference("ts"), expr_reference("event_id")))
  order <- rel_order(rel_proj, list(expr_reference("ts")))
  rel_df <- rel_to_altrep(order)
  expected_result <- data.frame(ts = c(1, 2, 3, 4, 5, 6, 7, 8, 9), event_id = c(0, 0, 1, 1, 1, 2, 2, 3, 3))
  expect_equal(expected_result, rel_df)
})

test_that("LEFT ASOF join works", {
  dbExecute(con, "CREATE OR REPLACE MACRO gte(a, b) AS a >= b")
  test_df1 <- rel_from_df(con, data.frame(ts = c(0, 1, 2, 3, 4, 5, 6, 7, 8, 9)))
  test_df2 <- rel_from_df(con, data.frame(event_ts = c(2, 4, 6, 8), event_id = c(0, 1, 2, 3)))
  cond <- list(expr_function("gte", list(expr_reference("ts"), expr_reference("event_ts"))))
  rel <- rel_join(test_df1, test_df2, cond, join = "left", join_ref_type = "asof")
  rel_proj <- rel_project(rel, list(expr_reference("ts"), expr_reference("event_ts"), expr_reference("event_id")))
  order <- rel_order(rel_proj, list(expr_reference("ts")))
  rel_df <- rel_to_altrep(order)
  expected_result <- data.frame(ts = c(0, 1, 2, 3, 4, 5, 6, 7, 8, 9), event_ts = c(NA, NA, 2, 2, 4, 4, 6, 6, 8, 8), event_id = c(NA, NA, 0, 0, 1, 1, 2, 2, 3, 3))
  expect_equal(expected_result, rel_df)
})

test_that("Positional cross join works", {
  test_df1 <- rel_from_df(con, data.frame(a = c(11, 12, 13), b = c(1, 2, 3)))
  test_df2 <- rel_from_df(con, data.frame(c = c(11, 12), d = c(1, 2)))
  rel <- rel_join(test_df1, test_df2, list(), join = "cross", join_ref_type = "positional")
  rel_df <- rel_to_altrep(rel)
  expected_result <- data.frame(a = c(11, 12, 13), b = c(1, 2, 3), c = c(11, 12, NA), d = c(1, 2, NA))
  expect_equal(expected_result, rel_df)
})

test_that("regular positional join works", {
  dbExecute(con, "CREATE OR REPLACE MACRO eq(a, b) AS a = b")
  test_df1 <- rel_from_df(con, data.frame(a = c(11, 12, 13), b = c(1, 2, 3)))
  test_df2 <- rel_from_df(con, data.frame(c = c(11, 12, 14, 11), d = c(4, 5, 6, 8)))
  cond <- expr_function("eq", list(expr_reference("a"), expr_reference("c")))
  rel <- rel_join(test_df1, test_df2, list(cond), join_ref_type = "positional")
  rel_df <- rel_to_altrep(rel)
  expected_result <- data.frame(a = c(11, 12), b = c(1, 2), c = c(11, 12), d = c(4, 5))
  expect_equal(expected_result, rel_df)
})

test_that("Invalid asof join condition throws error", {
  dbExecute(con, "CREATE OR REPLACE MACRO neq(a, b) AS a <> b")
  test_df1 <- rel_from_df(con, data.frame(ts = c(1, 2, 3, 4, 5, 6, 7, 8, 9)))
  test_df2 <- rel_from_df(con, data.frame(begin = c(1, 3, 6, 8), value = c(0, 1, 2, 3)))
  cond <- list(expr_function("neq", list(expr_reference("ts"), expr_reference("begin"))))
  expect_error(rel_join(test_df1, test_df2, cond, join_ref_type = "asof"), "Binder")
})

test_that("multiple inequality conditions for asof join throws error", {
  dbExecute(con, "CREATE OR REPLACE MACRO gte(a, b) AS a >= b")
  test_df1 <- rel_from_df(con, data.frame(ts = c(1, 2, 3, 4, 5, 6, 7, 8, 9)))
  test_df2 <- rel_from_df(con, data.frame(begin = c(1, 3, 6, 8), value = c(0, 1, 2, 3)))
  cond1 <- expr_function("gte", list(expr_reference("ts"), expr_reference("begin")))
  cond2 <- expr_function("gte", list(expr_reference("ts"), expr_reference("value")))
  conds <- list(cond1, cond2)
  expect_error(rel_join(test_df1, test_df2, conds, join_ref_type = "asof"), "Binder")
})


test_that("Inequality joins work", {
  dbExecute(con, "CREATE OR REPLACE MACRO gte(a, b) AS a >= b")
  timing_df <- rel_from_df(con, data.frame(ts = c(1, 2, 3, 4, 5, 6)))
  events_df <- rel_from_df(con, data.frame(event_ts = c(1, 3, 6, 8), event_id = c(0, 1, 2, 3)))
  cond <- list(expr_function("gte", list(expr_reference("ts"), expr_reference("event_ts"))))
  rel <- rel_inner_join(timing_df, events_df, cond)
  rel_proj <- rel_project(rel, list(expr_reference("ts"), expr_reference("event_ts")))
  rel_order <- rel_order(rel_proj, list(expr_reference("ts"), expr_reference("event_ts")))
  rel_df <- rel_to_altrep(rel_order)
  expected_result <- data.frame(ts = c(1, 2, 3, 3, 4, 4, 5, 5, 6, 6, 6), event_ts = c(1, 1, 1, 3, 1, 3, 1, 3, 1, 3, 6))
  expect_equal(expected_result, rel_df)
})


test_that("Inequality join works to perform between operation", {
  dbExecute(con, "CREATE OR REPLACE MACRO gt(a, b) AS a > b")
  dbExecute(con, "CREATE OR REPLACE MACRO lt(a, b) AS a < b")
  timing_df <- rel_from_df(con, data.frame(ts = c(1, 2, 3, 4, 5, 6, 7, 8, 9)))
  events_df <- rel_from_df(con, data.frame(event_ts = c(1, 3, 6, 8), event_id = c(0, 1, 2, 3)))
  lead <- expr_function("lead", list(expr_reference("event_ts")))
  window_lead <- expr_window(lead, offset_expr = expr_constant(1))
  expr_set_alias(window_lead, "lead")
  proj_window <- rel_project(events_df, list(expr_reference("event_ts"), window_lead, expr_reference("event_id")))
  cond1 <- expr_function("gt", list(expr_reference("ts"), expr_reference("event_ts")))
  cond2 <- expr_function("lt", list(expr_reference("ts"), expr_reference("lead")))
  conds <- list(cond1, cond2)
  rel <- rel_inner_join(timing_df, proj_window, conds)
  rel_proj <- rel_project(rel, list(expr_reference("ts")))
  rel_order <- rel_order(rel_proj, list(expr_reference("ts")))
  rel_df <- rel_to_altrep(rel_order)
  expected_result <- data.frame(ts = c(2, 4, 5, 7))
  expect_equal(expected_result, rel_df)
})


# nobody should do this in reality. It's a pretty dumb idea
test_that("we can union the same relation to itself", {
  test_df_a2 <- rel_from_df(con, data.frame(a = c("1", "2"), b = c("3", "4")))
  rel <- rel_union_all(test_df_a2, test_df_a2)
  rel_df <- rel_to_altrep(rel)
  expected_result <- data.frame(a = c("1", "2", "1", "2"), b = c("3", "4", "3", "4"))
  expect_equal(rel_df, expected_result)
})

test_that("we throw an error when attempting to union all relations that are not compatible", {
  test_df_a2 <- rel_from_df(con, data.frame(a = c("1", "2"), b = c("3", "4")))
  test_df_b2 <- rel_from_df(con, data.frame(a = c("1", "2"), b = c("3", "4"), c = c("5", "6")))
  # The two data frames have different dimensions, therefore you get a binding error.
  expect_error(rel_union_all(test_df_a2, test_df_b2), "Binder")
})

test_that("A union with different column types casts to the richer type", {
  test_df_a1 <- rel_from_df(con, data.frame(a = c(1)))
  test_df_a2 <- rel_from_df(con, data.frame(a = c("1")))
  rel <- rel_union_all(test_df_a1, test_df_a2)
  res <- rapi_rel_to_df(rel)
  expected <- data.frame(a = c("1.0", "1"))
  expect_equal(class(res$a), class(expected$a))
  expect_equal(res$a[1], expected$a[1])
  expect_equal(res$a[2], expected$a[2])
})

test_that("Set Intersect returns set intersection", {
  test_df_a <- rel_from_df(con, data.frame(a = c(1, 2), b = c(3, 4)))
  test_df_b <- rel_from_df(con, data.frame(a = c(1, 6), b = c(3, 8)))
  rel <- rel_set_intersect(test_df_a, test_df_b)
  ordered_rel <- rel_order(rel, list(expr_reference("a")))
  rel_df <- rel_to_altrep(rel)
  expect_false(df_is_materialized(rel_df))
  dim(rel_df)
  expected_result <- data.frame(a = c(1), b = c(3))
  expect_equal(rel_df, expected_result)
})

test_that("Set intersect casts columns to the richer type", {
  # df1 is Integer
  df1 <- data.frame(x = 1:4)
  # df2 has Double
  df2 <- data.frame(x = 4)
  expect_equal(class(df1$x), "integer")
  expect_equal(class(df2$x), "numeric")
  out <- rel_set_intersect(
    rel_from_df(con, df1),
    rel_from_df(con, df2)
  )
  out_df <- rapi_rel_to_df(out)
  expect_equal(class(out_df$x), "numeric")
})

test_that("Set Diff returns the set difference", {
  test_df_a <- rel_from_df(con, data.frame(a = c(1, 2), b = c(3, 4)))
  test_df_b <- rel_from_df(con, data.frame(a = c(1, 6), b = c(3, 8)))
  rel <- rel_set_diff(test_df_a, test_df_b)
  rel_df <- rel_to_altrep(rel)
  expect_false(df_is_materialized(rel_df))
  dim(rel_df)
  expected_result <- data.frame(a = c(2), b = c(4))
  expect_equal(rel_df, expected_result)
})

test_that("Symmetric difference returns the symmetric difference", {
  test_df_a <- rel_from_df(con, data.frame(a = c(1, 2), b = c(3, 4)))
  test_df_b <- rel_from_df(con, data.frame(a = c(1, 6), b = c(3, 8)))
  rel <- rel_set_symdiff(test_df_a, test_df_b)
  ordered_rel <- rel_order(rel, list(expr_reference("a"), expr_reference("b")))
  rel_df <- rel_to_altrep(ordered_rel)
  expect_false(df_is_materialized(rel_df))
  dim(rel_df)
  expected_result <- data.frame(a = c(2, 6), b = c(4, 8))
  expect_equal(rel_df, expected_result)
})

test_that("rel aggregate with no groups but a sum over a column, sums the column", {
  rel_a <- rel_from_df(con, data.frame(a = c(1, 2), b = c(3, 4)))
  aggrs <- list(sum = expr_function("sum", list(expr_reference("a"))))
  res <- rel_aggregate(rel_a, list(), aggrs)
  rel_df <- rel_to_altrep(res)
  expected_result <- data.frame(sum = c(3))
  expect_equal(rel_df, expected_result)
})

test_that("rel aggregate with groups and aggregate function works", {
  rel_a <- rel_from_df(con, data.frame(a = c(1, 2, 5, 5), b = c(3, 3, 4, 4)))
  aggrs <- list(sum = expr_function("sum", list(expr_reference("a"))))
  rel_b <- rel_aggregate(rel_a, list(expr_reference("b")), aggrs)
  res <- rel_order(rel_b, list(expr_reference("b")))
  rel_df <- rel_to_altrep(res)
  expected_result <- data.frame(b = c(3, 4), sum = c(3, 10))
  expect_equal(rel_df, expected_result)
})

test_that("Window sum expression function test works", {
  #   select j, i, sum(i) over (partition by j) from a order by 1,2
  rel_a <- rel_from_df(con, data.frame(a = c(1:8), b = c(1, 1, 2, 2, 3, 3, 4, 4)))
  sum_func <- expr_function("sum", list(expr_reference("a")))
  aggrs <- expr_window(sum_func, partitions = list(expr_reference("b")))
  expr_set_alias(aggrs, "window_result")
  window_proj <- rel_project(rel_a, list(expr_reference("a"), aggrs))
  order_over_window <- rel_order(window_proj, list(expr_reference("window_result")))
  res <- rel_to_altrep(order_over_window)
  expected_result <- data.frame(a = c(1:8), window_result = c(3, 3, 7, 7, 11, 11, 15, 15))
  expect_equal(res, expected_result)
})

test_that("Window count function works", {
  #   select a, b, count(b) over (partition by a) from a order by a
  rel_a <- rel_from_df(con, data.frame(a = c(1:8), b = c(1, 1, 2, 2, 3, 3, 4, 4)))
  count_func <- expr_function("count", list(expr_reference("a")))
  count <- expr_window(count_func, partitions = list(expr_reference("b")))
  expr_set_alias(count, "window_result")
  window_proj <- rel_project(rel_a, list(count))
  res <- rel_to_altrep(window_proj)
  expected_result <- data.frame(window_result = c(2, 2, 2, 2, 2, 2, 2, 2))
  expect_equal(res, expected_result)
})

test_that("Window avg function works", {
  #     select a, b, avg(b) over (partition by a) from a order by a
  rel_a <- rel_from_df(con, data.frame(a = c(1:8), b = c(1, 1, 2, 2, 3, 3, 4, 4)))
  avg_func <- expr_function("avg", list(expr_reference("a")))
  avg_window <- expr_window(avg_func, partitions = list(expr_reference("b")))
  expr_set_alias(avg_window, "window_result")
  window_proj <- rel_project(rel_a, list(avg_window))
  ordered <- rel_order(window_proj, list(expr_reference("window_result")))
  res <- rel_to_altrep(ordered)
  expected_result <- data.frame(window_result = c(1.5, 1.5, 3.5, 3.5, 5.5, 5.5, 7.5, 7.5))
  expect_equal(res, expected_result)
})

test_that("Window sum with Partition, order, and window boundaries works", {
  #     SUM(x) OVER (partition by b ROWS BETWEEN 3 PRECEDING AND CURRENT ROW)
  rel_a <- rel_from_df(con, data.frame(a = c(1:8), b = c(1, 1, 1, 1, 2, 2, 2, 2)))
  partitions <- list(expr_reference("b"))
  order_by_a <- list(rel_order(rel_a, list(expr_reference("a"))))
  sum_func <- expr_function("sum", list(expr_reference("a")))
  sum_window <- expr_window(sum_func,
    partitions = partitions,
    order_bys = list(expr_reference("a")),
    window_boundary_start = "expr_preceding_rows",
    window_boundary_end = "current_row_rows",
    start_expr = expr_constant(2)
  )
  expr_set_alias(sum_window, "window_result")
  window_proj <- rel_project(rel_a, list(expr_reference("a"), sum_window))
  proj_order <- rel_order(window_proj, list(expr_reference("a")))
  res <- rel_to_altrep(proj_order)
  expected_result <- data.frame(a = c(1:8), window_result = c(1, 3, 6, 9, 5, 11, 18, 21))
  expect_equal(res, expected_result)
})

test_that("Window boundaries boundaries are CaSe INsenSItive", {
  #     SUM(x) OVER (partition by b ROWS BETWEEN 3 PRECEDING AND CURRENT ROW)
  rel_a <- rel_from_df(con, data.frame(a = c(1:8), b = c(1, 1, 1, 1, 2, 2, 2, 2)))
  partitions <- list(expr_reference("b"))
  order_by_a <- list(rel_order(rel_a, list(expr_reference("a"))))
  sum_func <- expr_function("sum", list(expr_reference("a")))
  sum_window <- expr_window(sum_func,
    partitions = partitions,
    order_bys = list(expr_reference("a")),
    window_boundary_start = "exPr_PREceding_rOWs",
    window_boundary_end = "cURrEnt_rOw_RoWs",
    start_expr = expr_constant(2)
  )
  expr_set_alias(sum_window, "window_result")
  window_proj <- rel_project(rel_a, list(expr_reference("a"), sum_window))
  proj_order <- rel_order(window_proj, list(expr_reference("a")))
  res <- rel_to_altrep(proj_order)
  expected_result <- data.frame(a = c(1:8), window_result = c(1, 3, 6, 9, 5, 11, 18, 21))
  expect_equal(res, expected_result)
})

test_that("Window avg with a filter expression and partition works", {
  #   select a, b, avg(a) FILTER (WHERE x % 2 = 0) over (partition by b)
  DBI::dbExecute(con, "CREATE OR REPLACE MACRO mod(a, b) as a % b")
  DBI::dbExecute(con, "CREATE OR REPLACE MACRO eq(a, b) as a = b")
  rel_a <- rel_from_df(con, data.frame(a = c(1:8), b = c(1, 1, 2, 2, 3, 3, 4, 4)))
  partitions <- list(expr_reference("b"))
  mod_function <- expr_function("mod", list(expr_reference("a"), expr_constant(2)))
  zero <- expr_constant(0)
  filters <- list(expr_function("eq", list(zero, mod_function)))
  avg_func <- expr_function("avg", args = list(expr_reference("a")), filter_bys = filters)
  avg_filter_window <- expr_window(avg_func, partitions = partitions)
  expr_set_alias(avg_filter_window, "avg_filter")
  window_proj <- rel_project(rel_a, list(avg_filter_window))
  proj_order <- rel_order(window_proj, list(expr_reference("avg_filter")))
  expected_result <- data.frame(avg_filter = c(2, 2, 4, 4, 6, 6, 8, 8))
  res <- rel_to_altrep(proj_order)
  expect_equal(res, expected_result)
})

test_that("Window lag function works as expected", {
  #   select a, b, lag(a, 1) OVER () order by a
  rel_a <- rel_from_df(con, data.frame(a = c(1:8), b = c(1, 1, 2, 2, 3, 3, 4, 4)))
  lag <- expr_function("lag", list(expr_reference("a")))
  window_lag <- expr_window(lag, offset_expr = expr_constant(1))
  expr_set_alias(window_lag, "lag")
  proj_window <- rel_project(rel_a, list(expr_reference("a"), window_lag))
  order_over_window <- rel_order(proj_window, list(expr_reference("a")))
  expected_result <- data.frame(a = c(1:8), lag = c(NA, 1, 2, 3, 4, 5, 6, 7))
  res <- rel_to_altrep(order_over_window)
  expect_equal(res, expected_result)
})


test_that("function name for window is case insensitive", {
  #   select a, b, lag(a, 1) OVER () order by a
  rel_a <- rel_from_df(con, data.frame(a = c(1:8), b = c(1, 1, 2, 2, 3, 3, 4, 4)))
  lag <- expr_function("LAG", list(expr_reference("a")))
  window_lag <- expr_window(lag, offset_expr = expr_constant(1))
  expr_set_alias(window_lag, "lag")
  proj_window <- rel_project(rel_a, list(expr_reference("a"), window_lag))
  order_over_window <- rel_order(proj_window, list(expr_reference("a")))
  expected_result <- data.frame(a = c(1:8), lag = c(NA, 1, 2, 3, 4, 5, 6, 7))
  res <- rel_to_altrep(order_over_window)
  expect_equal(res, expected_result)
})

test_that("Window lead function works as expected", {
  #   select a, b, lag(a, 1) OVER () order by a
  rel_a <- rel_from_df(con, data.frame(a = c(1:8), b = c(1, 1, 2, 2, 3, 3, 4, 4)))
  lead <- expr_function("lead", list(expr_reference("a")))
  window_lead <- expr_window(lead, offset_expr = expr_constant(1))
  expr_set_alias(window_lead, "lead")
  proj_window <- rel_project(rel_a, list(expr_reference("a"), window_lead))
  order_over_window <- rel_order(proj_window, list(expr_reference("a")))
  expected_result <- data.frame(a = c(1:8), lead = c(2, 3, 4, 5, 6, 7, 8, NA))
  res <- rel_to_altrep(order_over_window)
  expect_equal(res, expected_result)
})

test_that("Window function with string aggregate works", {
  #   select j, s, string_agg(s, '|') over (partition by b) from a order by j, s;
  rel_a <- rel_from_df(con, data.frame(r = c(1, 2, 3, 4), a = c("hello", "Big", "world", "42"), b = c(1, 1, 2, 2)))
  str_agg <- expr_function("string_agg", list(expr_reference("a")))
  partitions <- list(expr_reference("b"))
  window_str_cat <- expr_window(str_agg, partitions = partitions)
  expr_set_alias(window_str_cat, "str_agg_res")
  proj_window <- rel_project(rel_a, list(expr_reference("r"), window_str_cat))
  order_over_window <- rel_order(proj_window, list(expr_reference("r")))
  expected_result <- data.frame(r = c(1:4), str_agg_res = c("hello,Big", "hello,Big", "world,42", "world,42"))
  res <- rel_to_altrep(order_over_window)
  expect_equal(res, expected_result)
})

test_that("You can perform window functions on row_number", {
  # select a, b, row_number() OVER () from tmp order by a;
  rel_a <- rel_from_df(con, data.frame(a = c(8:1), b = c(1, 1, 2, 2, 3, 3, 4, 4)))
  row_number <- expr_function("row_number", list())
  window_function <- expr_window(row_number)
  expr_set_alias(window_function, "row_number")
  proj <- rel_project(rel_a, list(expr_reference("a"), window_function))
  order_by_a <- rel_order(proj, list(expr_reference("a")))
  expected_result <- data.frame(a = c(1:8), row_number = (8:1))
  res <- rel_to_altrep(order_by_a)
  expect_equal(res, expected_result)
})

# also tests order by inside the rank function.
# these tests come from https://dplyr.tidyverse.org/articles/window-functions.html
# in dplyr min_rank = rank
test_that("You can perform the window function min_rank", {
  # select rank() OVER (order by a) from t1
  rel_a <- rel_from_df(con, data.frame(a = c(1, 1, 2, 2, 2)))
  rank_func <- expr_function("rank", list())
  min_rank_window <- expr_window(rank_func, order_bys = list(expr_reference("a")))
  expr_set_alias(min_rank_window, "window_result")
  window_proj <- rel_project(rel_a, list(expr_reference("a"), min_rank_window))
  res <- rel_to_altrep(window_proj)
  expected_result <- data.frame(a = c(1, 1, 2, 2, 2), window_result = c(1, 1, 3, 3, 3))
  expect_equal(res, expected_result)
})

test_that("You can perform the window function dense_rank", {
  # select dense_rank() OVER (order by a) from t1;
  rel_a <- rel_from_df(con, data.frame(a = c(1, 1, 2, 2, 2)))
  dense_rank_fun <- expr_function("dense_rank", list())
  min_rank_window <- expr_window(dense_rank_fun, order_bys = list(expr_reference("a")))
  expr_set_alias(min_rank_window, "window_result")
  window_proj <- rel_project(rel_a, list(expr_reference("a"), min_rank_window))
  res <- rel_to_altrep(window_proj)
  expected_result <- data.frame(a = c(1, 1, 2, 2, 2), window_result = c(1, 1, 2, 2, 2))
  expect_equal(res, expected_result)
})

test_that("You can perform the window function cume_dist", {
  # select cume_dist() OVER (order by a) from t1;
  rel_a <- rel_from_df(con, data.frame(a = c(1, 1, 2, 2, 2)))
  cume_dist_func <- expr_function("cume_dist", list())
  cume_dist_window <- expr_window(cume_dist_func, order_bys = list(expr_reference("a")))
  expr_set_alias(cume_dist_window, "cume_dist")
  window_proj <- rel_project(rel_a, list(expr_reference("a"), cume_dist_window))
  order_proj <- rel_order(window_proj, list(expr_reference("a")))
  res <- rel_to_altrep(order_proj)
  expected_result <- data.frame(a = c(1, 1, 2, 2, 2), cume_dist = c(0.4, 0.4, 1.0, 1.0, 1.0))
  expect_equal(res, expected_result)
})

test_that("You can perform the window function percent rank", {
  # select percent_rank() OVER (order by a) from t1;
  rel_a <- rel_from_df(con, data.frame(a = c(5, 1, 3, 2, 2)))
  percent_rank_func <- expr_function("percent_rank", list())
  percent_rank_wind <- expr_window(percent_rank_func, order_bys = list(expr_reference("a")))
  expr_set_alias(percent_rank_wind, "percent_rank")
  window_proj <- rel_project(rel_a, list(expr_reference("a"), percent_rank_wind))
  order_proj <- rel_order(window_proj, list(expr_reference("a")))
  res <- rel_to_altrep(order_proj)
  expected_result <- data.frame(a = c(1, 2, 2, 3, 5), percent_rank = c(0.00, 0.25, 0.25, 0.75, 1.00))
  expect_equal(res, expected_result)
})

# with and without offsets
test_that("R semantics for adding NaNs is respected", {
  dbExecute(con, "CREATE OR REPLACE MACRO eq(a, b) AS a = b")
  test_df_a <- rel_from_df(con, data.frame(a = c(1, 2), b = c(3, 4)))
  test_df_b <- rel_from_df(con, data.frame(c = c(NaN, 6), d = c(3, 8)))
  cond <- list(expr_function("eq", list(expr_reference("b"), expr_reference("d"))))
  rel_join <- rel_join(test_df_a, test_df_b, cond, "inner")
  addition_expression <- expr_function("+", list(expr_reference("a"), expr_reference("c")))
  proj <- rel_project(rel_join, list(addition_expression))
  res <- rapi_rel_to_df(proj)
  expect_true(is.na(res[[1]]))
})

test_that("R semantics for arithmetics sum function are respected", {
  test_df_a <- rel_from_df(con, data.frame(a = c(1:5, NA)))
  sum_rel <- expr_function("sum", list(expr_reference("a")))
  ans <- rel_aggregate(test_df_a, list(), list(sum_rel))
  res <- rel_to_altrep(ans)
  expect_equal(res[[1]], 15)
})

test_that("anti joins for eq_na_matches works", {
  dbExecute(con, 'CREATE OR REPLACE MACRO "___eq_na_matches_na"(a, b) AS ((a IS NULL AND b IS NULL) OR (a = b))')
  rel1 <- rel_from_df(con, data.frame(x = c(1, 1, 2, 3)))
  rel2 <- rel_from_df(con, data.frame(y = c(2, 3, 3, 4)))
  cond <- list(expr_function("___eq_na_matches_na", list(expr_reference("x"), expr_reference("y"))))
  out <- rel_join(rel1, rel2, cond, "anti")
  res <- rel_to_altrep(out)
  expect_equal(res, data.frame(x = c(1, 1)))
})

test_that("semi joins for eq_na_matches works", {
  dbExecute(con, 'CREATE OR REPLACE MACRO "___eq_na_matches_na"(a, b) AS ((a IS NULL AND b IS NULL) OR (a = b))')
  rel1 <- rel_from_df(con, data.frame(x = c(1, 1, 2, 2)))
  rel2 <- rel_from_df(con, data.frame(y = c(2, 2, 2, 2, 3, 3, 3)))
  cond <- list(expr_function("___eq_na_matches_na", list(expr_reference("x"), expr_reference("y"))))
  out <- rel_join(rel1, rel2, cond, "semi")
  res <- rel_to_altrep(out)
  expect_equal(res, data.frame(x = c(2, 2)))
})

test_that("rel_project does not automatically quote upper-case column names", {
  df <- data.frame(B = 1)
  rel <- rel_from_df(con, df)
  ref <- expr_reference(names(df))
  exprs <- list(ref)
  proj <- rel_project(rel, exprs)
  ans <- rel_to_altrep(proj)
  expect_equal(df, ans)
})

test_that("rel_tostring()", {
  local_edition(3)

  df <- data.frame(x = 1)
  rel <- rel_from_df(con, df)
  ref <- expr_reference(names(df))
  exprs <- list(ref)
  proj <- rel_project(rel, exprs)

  expect_snapshot(transform = function(x) gsub("0x[0-9a-f]+", "0x...", x), {
    writeLines(rel_tostring(proj))
  })

  expect_snapshot(transform = function(x) gsub("0x[0-9a-f]+", "0x...", x), {
    writeLines(rel_tostring(proj, "tree"))
  })
})

test_that("rel_explain()", {
  skip_if(getRversion() < "4.2")
  local_edition(3)

  df <- data.frame(x = 1)
  rel <- rel_from_df(con, df)
  ref <- expr_reference(names(df))
  exprs <- list(ref)
  proj <- rel_project(rel, exprs)

  expect_snapshot({
    writeLines(rel_explain_df(proj)[[2]])
  })

  expect_snapshot({
    writeLines(rel_explain_df(proj, "analyze")[[2]])
  })

  expect_snapshot({
    writeLines(rel_explain_df(proj, "standard", "json")[[2]])
  })

  expect_snapshot({
    writeLines(rel_explain_df(proj, "analyze", "json")[[2]])
  })

  expect_snapshot({
    writeLines(rel_explain_df(proj, "standard", "html")[[2]])
  })

  expect_snapshot({
    writeLines(rel_explain_df(proj, "standard", "graphviz")[[2]])
  })
})

test_that("rel_to_sql works for row_number", {
  invisible(DBI::dbExecute(con, "CREATE MACRO \"==\"(a, b) AS a = b"))
  df1 <- data.frame(a = 1)
  rel1 <- rel_from_df(con, df1)
  rel2 <- rel_project(
    rel1,
    list({
      tmp_expr <- expr_window(expr_function("row_number", list()), list(), list(), offset_expr = NULL, default_expr = NULL)
      expr_set_alias(tmp_expr, "___row_number")
      tmp_expr
    })
  )
  sql <- rel_to_sql(rel2)
  sub_str_sql <- substr(sql, 0, 44)
  expect_equal(sub_str_sql, "SELECT row_number() OVER () AS ___row_number")
})

test_that("rel_from_table_function works", {
  rel <- rel_from_table_function(con, "generate_series", list(1L, 10L, 2L))
  df <- as.data.frame(rel)
  expect_equal(df$generate_series, c(1, 3, 5, 7, 9))
})

test_that("we don't crash with evaluation errors", {
  invisible(DBI::dbExecute(con, "CREATE OR REPLACE MACRO \"==\"(x, y) AS x = y"))
  df1 <- data.frame(a = "a")

  rel1 <- rel_from_df(con, df1)
  rel2 <- rel_project(
    rel1,
    list(
      {
        tmp_expr <- expr_reference("a")
        expr_set_alias(tmp_expr, "a")
        tmp_expr
      },
      {
        tmp_expr <- expr_function(
          "==",
          list(expr_reference("a"), expr_constant(1))
        )
        expr_set_alias(tmp_expr, "b")
        tmp_expr
      }
    )
  )

  ans <- rel_to_altrep(rel2)

  # This query is supposed to throw a runtime error.
  # If this succeeds, find a new query that throws a runtime error.
  expect_error(nrow(ans), "Error evaluating duckdb query")
})

test_that("we don't crash with evaluation errors", {
  invisible(DBI::dbExecute(con, "CREATE OR REPLACE MACRO \"==\"(x, y) AS x = y"))
  df1 <- data.frame(a = "a")

  rel1 <- rel_from_df(con, df1)
  rel2 <- rel_project(
    rel1,
    list(
      {
        tmp_expr <- expr_reference("a")
        expr_set_alias(tmp_expr, "a")
        tmp_expr
      },
      {
        tmp_expr <- expr_function(
          "==",
          list(expr_reference("a"), expr_constant(1))
        )
        expr_set_alias(tmp_expr, "b")
        tmp_expr
      }
    )
  )

  ans <- rel_to_altrep(rel2)

  # This query is supposed to throw a runtime error.
  # If this succeeds, find a new query that throws a runtime error.
  expect_error(nrow(ans), "Error evaluating duckdb query")
})

test_that("Handle zero-length lists (#186)", {
  local_edition(3)

  expect_snapshot({
    expr_constant(list(integer()))
  })
})

test_that("prudence", {
  skip_if(getRversion() < "4.2", "Error message formatting differs in R 4.1")
  local_edition(3)
  withr::local_envvar(NO_COLOR = "true")

  invisible(DBI::dbExecute(con, "CREATE MACRO \"<=\"(a, b) AS a <= b"))
  df1 <- data.frame(a = 1:10, b = 1:10)

  rel1 <- rel_from_df(con, df1)
  rel2 <- rel_filter(
    rel1,
    list(
      expr_function(
        "<=",
        list(
          expr_reference("a"),
          expr_constant(5L)
        )
      )
    )
  )

  forbid <- rel_to_altrep(rel2, allow_materialization = FALSE)
  expect_snapshot(error = TRUE, {
    nrow(forbid)
  })

  forbid_nrow <- rel_to_altrep(rel2, n_cells = 0)
  expect_snapshot(error = TRUE, {
    nrow(forbid)
  })

  five_rows <- rel_to_altrep(rel2, n_rows = 5)
  expect_error(nrow(five_rows), NA)

  four_rows <- rel_to_altrep(rel2, n_rows = 4)
  expect_snapshot(error = TRUE, {
    nrow(four_rows)
  })

  ten_cells <- rel_to_altrep(rel2, n_cells = 10)
  expect_error(nrow(ten_cells), NA)

  nine_cells <- rel_to_altrep(rel2, n_cells = 9)
  expect_snapshot(error = TRUE, {
    nrow(nine_cells)
  })

  ok_both <- rel_to_altrep(rel2, n_rows = 5, n_cells = 10)
  expect_error(nrow(ok_both), NA)

  bad_rows <- rel_to_altrep(rel2, n_rows = 4, n_cells = 10)
  expect_snapshot(error = TRUE, {
    nrow(bad_rows)
  })

  bad_cells <- rel_to_altrep(rel2, n_rows = 5, n_cells = 9)
  expect_snapshot(error = TRUE, {
    nrow(bad_cells)
  })
})

test_that("rel_to_view()", {
  df1 <- data.frame(a = 1:10, b = 1:10)
  rel1 <- rel_from_df(con, df1)
  rel_to_view(rel1, "", "test_view", temporary = TRUE)

  expect_equal(dbGetQuery(con, "SELECT * FROM test_view"), df1)
  expect_error(dbExecute(con, "DROP VIEW test_view"), NA)
})

test_that("logical", {
  df1 <- data.frame(a = c(TRUE, FALSE, NA))
  rel <- rel_from_df(con, df1)
  expect_equal(rel_to_altrep(rel), df1)

  skip_if_not_installed("vctrs")

  df2 <- vctrs::new_data_frame(list(a = structure(c(TRUE, FALSE, NA), class = "foo")))
  rel <- rel_from_df(con, df2, strict = FALSE)
  expect_equal(rel_to_altrep(rel), df1)

  expect_error(rel_from_df(con, df2), "convert")
})

test_that("integer", {
  df1 <- data.frame(a = c(1L, 2L, NA))
  rel <- rel_from_df(con, df1)
  expect_equal(rel_to_altrep(rel), df1)

  skip_if_not_installed("vctrs")

  df2 <- vctrs::new_data_frame(list(a = structure(c(1L, 2L, NA), class = "foo")))
  rel <- rel_from_df(con, df2, strict = FALSE)
  expect_equal(rel_to_altrep(rel), df1)

  expect_error(rel_from_df(con, df2), "convert")
})

test_that("numeric", {
  df1 <- data.frame(a = c(1, 2, NA))
  rel <- rel_from_df(con, df1)
  expect_equal(rel_to_altrep(rel), df1)

  skip_if_not_installed("vctrs")

  df2 <- vctrs::new_data_frame(list(a = structure(c(1, 2, NA), class = "foo")))
  rel <- rel_from_df(con, df2, strict = FALSE)
  expect_equal(rel_to_altrep(rel), df1)

  expect_error(rel_from_df(con, df2), "convert")
})

test_that("list", {
  skip_if_not_installed("vctrs")
  skip_if(getRversion() < "4.3")

  df1 <- vctrs::new_data_frame(list(a = list(1L, 2:3, NULL, 4:6)))
  rel <- rel_from_df(con, df1)
  expect_equal(rel_to_altrep(rel), df1)

  df2 <- vctrs::new_data_frame(list(a = structure(list(1L, 2:3, NULL, 4:6), class = "foo")), n = 4L)
  rel <- rel_from_df(con, df2, strict = FALSE)
  expect_equal(rel_to_altrep(rel), df1)

  expect_error(rel_from_df(con, df2), "convert")
})

test_that("Date", {
  df1 <- data.frame(a = as.Date(c("2020-01-01", "2020-01-02", NA)))
  rel <- rel_from_df(con, df1)
  expect_equal(rel_to_altrep(rel), df1)

  skip_if_not_installed("vctrs")

  df2 <- vctrs::new_data_frame(list(a = structure(as.Date(c("2020-01-01", "2020-01-02", NA)), class = c("foo", "Date"))))
  rel <- rel_from_df(con, df2, strict = FALSE)
  expect_equal(rel_to_altrep(rel), df1)

  expect_error(rel_from_df(con, df2), "convert")
})

test_that("difftime", {
  df1 <- data.frame(a = as.difftime(c(1, 2, NA), units = "secs"))
  rel <- rel_from_df(con, df1)
  expect_equal(rel_to_altrep(rel), df1)

  skip_if_not_installed("vctrs")

  df2 <- vctrs::new_data_frame(list(a = structure(as.difftime(c(1, 2, NA), units = "secs"), class = c("foo", "difftime"))))
  rel <- rel_from_df(con, df2, strict = FALSE)
  expect_equal(rel_to_altrep(rel), df1)

  expect_error(rel_from_df(con, df2), "convert")
})

test_that("factor", {
  df1 <- data.frame(a = factor(c("a", "b", NA)))
  rel <- rel_from_df(con, df1)
  expect_equal(rel_to_altrep(rel), df1)

  df2 <- data.frame(a = ordered(c("a", "b", NA)))
  rel <- rel_from_df(con, df2, strict = FALSE)
  expect_equal(rel_to_altrep(rel), df1)

  expect_error(rel_from_df(con, df2), "convert")
})

test_that("data.frame", {
  skip_if_not_installed("vctrs")
  skip_if(getRversion() < "4.3")

  df1 <- vctrs::new_data_frame(list(a = data.frame(b = 1:3, c = 4:6)))
  rel <- rel_from_df(con, df1)
  expect_equal(rel_to_altrep(rel), df1)

  df2 <- vctrs::new_data_frame(list(a = structure(data.frame(b = 1:3, c = 4:6), class = c("foo", "data.frame"))))
  rel <- rel_from_df(con, df2, strict = FALSE)
  expect_equal(rel_to_altrep(rel), df1)

  expect_error(rel_from_df(con, df2), "convert")
})

test_that("POSIXct", {
  df1 <- data.frame(a = structure(1745781814.84963, class = c("POSIXct", "POSIXt"), tzone = "UTC"))
  rel <- rel_from_df(con, df1)
  expect_equal(rel_to_altrep(rel), df1)

  df2 <- data.frame(a = structure(1745781814.84963, class = c("foo", "POSIXct", "POSIXt")))
  rel <- rel_from_df(con, df2, strict = FALSE)
  expect_equal(rel_to_altrep(rel), df1)

  expect_error(rel_from_df(con, df2), "convert")

  df2 <- data.frame(a = structure(1745781814.84963, class = c("foo", "POSIXct", "POSIXt"), tzone = ""))
  rel <- rel_from_df(con, df2, strict = FALSE)
  expect_equal(rel_to_altrep(rel), df1)

  expect_error(rel_from_df(con, df2), "convert")

  skip_if_not_installed("vctrs")

  df2 <- data.frame(a = structure(1745781814.84963, class = c("foo", "POSIXct", "POSIXt"), tzone = "UTC"))
  rel <- rel_from_df(con, df2, strict = FALSE)
  expect_equal(rel_to_altrep(rel), df1)

  expect_error(rel_from_df(con, df2), "convert")
})

test_that("rel_order() supports descending order", {
  test_df <- rel_from_df(con, data.frame(a = c(1:3)))
  orders <- list(expr_reference("a"))
  rel <- rel_order(test_df, orders, ascending = FALSE)
  expected_result <- data.frame(a = c(3L, 2L, 1L))
  expect_equal(rel_to_altrep(rel), expected_result)
})

test_that("rel_order() supports nulls_first", {
  test_df <- rel_from_df(con, data.frame(a = c(NA, 1:3)))
  orders <- list(expr_reference("a"))
  rel <- rel_order(test_df, orders, nulls_first = TRUE)
  expected_result <- data.frame(a = c(NA, 1L, 2L, 3L))
  expect_equal(rel_to_altrep(rel), expected_result)
})

test_that("rel_order() nulls_first error checking works", {
  test_df <- rel_from_df(con, data.frame(a = c(1:3)))
  orders <- list(expr_reference("a"), expr_reference("a"))
  expect_error(rel_order(test_df, orders, nulls_first = c(TRUE, FALSE, TRUE)), "length of nulls_first")
})

test_that("expr_window() supports descending order_bys", {
  # rank() OVER (ORDER BY a DESC) should give reverse ranks
  rel_a <- rel_from_df(con, data.frame(a = c(1, 2, 3)))
  rank_func <- expr_function("rank", list())
  rank_window <- expr_window(rank_func,
    order_bys = list(expr_reference("a")),
    ascending = FALSE
  )
  expr_set_alias(rank_window, "rank_desc")
  window_proj <- rel_project(rel_a, list(expr_reference("a"), rank_window))
  proj_order <- rel_order(window_proj, list(expr_reference("a")))
  res <- rel_to_altrep(proj_order)
  expected_result <- data.frame(a = c(1, 2, 3), rank_desc = c(3L, 2L, 1L))
  expect_equal(res, expected_result)
})

test_that("expr_window() supports nulls_first in order_bys", {
  # rank() OVER (ORDER BY a NULLS FIRST) - NULLs should get rank 1
  rel_a <- rel_from_df(con, data.frame(a = c(1, 2, NA)))
  rank_func <- expr_function("rank", list())
  rank_window <- expr_window(rank_func,
    order_bys = list(expr_reference("a")),
    nulls_first = TRUE
  )
  expr_set_alias(rank_window, "rank_nulls_first")
  window_proj <- rel_project(rel_a, list(expr_reference("a"), rank_window))
  proj_order <- rel_order(window_proj, list(expr_reference("a")))
  res <- rel_to_altrep(proj_order)
  # With NULLS FIRST: NULL gets rank 1, 1 gets rank 2, 2 gets rank 3
  expected_result <- data.frame(a = c(1, 2, NA), rank_nulls_first = c(2L, 3L, 1L))
  expect_equal(res, expected_result)
})

test_that("expr_window() ascending/nulls_first error checking works", {
  rank_func <- expr_function("rank", list())
  expect_error(
    expr_window(rank_func,
      order_bys = list(expr_reference("a")),
      ascending = c(TRUE, FALSE)
    ),
    "length of ascending"
  )
  expect_error(
    expr_window(rank_func,
      order_bys = list(expr_reference("a")),
      nulls_first = c(TRUE, FALSE)
    ),
    "length of nulls_first"
  )
})

test_that("rel_from_sql() works with registered tables", {
  con <- local_con()
  DBI::dbWriteTable(con, "mtcars_t", mtcars)
  rel <- rel_from_sql(con, "SELECT cyl, mpg FROM mtcars_t")
  expect_s3_class(rel, "duckdb_relation")
  df <- as.data.frame(rel)
  expect_equal(df$mpg, mtcars$mpg)
  expect_equal(df$cyl, mtcars$cyl)
})

test_that("rel_from_sql() surfaces parser errors", {
  con <- local_con()
  expect_error(rel_from_sql(con, "SELECT FROM"))
})

test_that("rel_from_sql() scans data frames from the caller env by default", {
  con <- local_con(drv = duckdb(environment_scan = TRUE))

  df_local <- data.frame(a = 1:3, b = letters[1:3])
  rel <- rel_from_sql(con, "FROM df_local")
  expect_s3_class(rel, "duckdb_relation")
  expect_setequal(names(rel), c("a", "b"))
})

test_that("rel_from_sql() honours an explicit env argument", {
  con <- local_con(drv = duckdb(environment_scan = TRUE))

  scan_env <- new.env(parent = emptyenv())
  scan_env$df_env <- data.frame(a = 1L, b = 2L)

  rel <- rel_from_sql(con, "FROM df_env", env = scan_env)
  expect_s3_class(rel, "duckdb_relation")
  expect_setequal(names(rel), c("a", "b"))
})

test_that("rel_from_sql() does not scan with environment_scan = FALSE", {
  con <- local_con()

  df_local <- data.frame(a = 1L)
  expect_error(rel_from_sql(con, "FROM df_local"))
})

test_that("rel_from_sql() rejects non-environment env", {
  con <- local_con()
  expect_error(
    rel_from_sql(con, "SELECT 1", env = list()),
    "env.*environment"
  )
})

test_that("rel_from_sql() falls back to the database catalog", {
  # Even with env scanning off, plain table references must still resolve.
  con <- local_con()
  DBI::dbWriteTable(con, "cat_tbl", data.frame(a = 1L))

  rel <- rel_from_sql(con, "SELECT a FROM cat_tbl")
  expect_equal(as.data.frame(rel), data.frame(a = 1L), ignore_attr = TRUE)
})

test_that("rel_from_sql() relations can be materialized after the env is gone", {
  con <- local_con(drv = duckdb(environment_scan = TRUE))

  create_rel <- function() {
    df <- data.frame(a = 1:3)
    rel_from_sql(con, "FROM df")
  }

  rel <- create_rel()

  # The data frame is no longer reachable from the calling R code, but it
  # is kept alive by the relation's protection list.
  gc(); gc()

  expect_equal(as.data.frame(rel), data.frame(a = 1:3), ignore_attr = TRUE)
})

test_that("rel_from_sql() relations can be used in further relational ops", {
  con <- local_con(drv = duckdb(environment_scan = TRUE))

  df <- data.frame(a = 1:5, b = c(2, 2, 3, 3, 4))
  rel <- rel_from_sql(con, "FROM df")
  rel2 <- rel_filter(rel, list(
    expr_comparison("=", list(expr_reference("b"), expr_constant(3)))
  ))

  out <- as.data.frame(rel2)
  expect_equal(out$a, c(3L, 4L), ignore_attr = TRUE)
})
