# Never run on CRAN, even if they have sf, because we don't regularly
# check these on CI and we don't want a change in sf to force a CRAN
# failure for vctrs.
skip_on_cran()

# Avoids adding `sf` to Suggests.
# These tests are only run on the devs' machines.
testthat_import_from(
  "sf",
  c(
    "st_sf",
    "st_sfc",
    "st_point",
    "st_bbox",
    "st_precision",
    "st_crs",
    "st_linestring",
    "st_as_sf",
    "st_multipoint"
  )
)

# Need recent version to work around restore bug for sfc lists and changes
# to `c.sfc()`
skip_if_not_installed("sf", "1.0-11")

test_that("sf has a ptype2 method", {
  sfc1 = st_sfc(st_point(1:2), st_point(3:4))
  sfc2 = st_sfc(st_linestring(matrix(1:4, 2)))

  sf1 = st_sf(x = c(TRUE, FALSE), geo1 = sfc1)
  sf2 = st_sf(y = "", geo2 = sfc2, x = 0, stringsAsFactors = FALSE)

  out = vctrs::vec_ptype2(sf1, sf2)
  exp = st_sf(
    x = double(),
    y = character(),
    geo1 = sfc1[0],
    geo2 = sfc2[0],
    stringsAsFactors = FALSE
  )
  expect_identical(out, exp)

  out = vctrs::vec_ptype2(sf1, new_data_frame(sf2))
  expect_identical(out, exp)

  out = vctrs::vec_ptype2(new_data_frame(sf1), sf2)
  exp_rhs = st_sf(
    x = double(),
    y = character(),
    geo1 = sfc1[0],
    geo2 = sfc2[0],
    stringsAsFactors = FALSE,
    sf_column_name = "geo2"
  )
  expect_identical(out, exp_rhs)
})

test_that("sf has a cast method", {
  sfc1 = st_sfc(st_point(1:2), st_point(3:4))
  sfc2 = st_sfc(st_linestring(matrix(1:4, 2)))

  sf1 = st_sf(x = c(TRUE, FALSE), geo1 = sfc1)
  sf2 = st_sf(y = "", geo2 = sfc2, x = 0, stringsAsFactors = FALSE)

  expect_error(
    vctrs::vec_cast(sf1, sf2),
    class = "vctrs_error_cast_lossy"
  )
  expect_error(
    vctrs::vec_cast(sf2, sf1),
    class = "vctrs_error_cast_lossy"
  )

  common = vec_ptype2(sf1, sf2)

  out = vctrs::vec_cast(sf1, common)
  exp = st_sf(
    x = c(1, 0),
    y = character(2)[NA],
    geo1 = sfc1,
    geo2 = sfc2[c(NA, NA) + 0L],
    stringsAsFactors = FALSE
  )
  expect_identical(out, exp)

  out = vctrs::vec_cast(new_data_frame(sf1), common)
  expect_identical(out, exp)

  out = vctrs::vec_cast(sf1, new_data_frame(common))
  expect_identical(out, new_data_frame(exp))

  out = vctrs::vec_cast(sf2, common)
  exp = st_sf(
    x = 0,
    y = "",
    geo1 = sfc1[NA + 0L],
    geo2 = sfc2,
    stringsAsFactors = FALSE
  )
  expect_identical(out, exp)
})

# https://github.com/r-lib/vctrs/issues/1136
test_that("can combine sf data frames", {
  testthat_import_from("dplyr", "bind_rows")

  sfc1 = st_sfc(st_point(1:2), st_point(3:4))
  sfc2 = st_sfc(st_linestring(matrix(1:4, 2)))

  sf1 = st_sf(x = c(TRUE, FALSE), geo1 = sfc1)
  sf2 = st_sf(y = "", geo2 = sfc2, x = 0, stringsAsFactors = FALSE)

  exp = data_frame(
    x = c(1, 0, 0),
    geo1 = sfc1[c(1:2, NA)],
    y = c(NA, NA, ""),
    geo2 = sfc2[c(NA, NA, 1)]
  )
  expect_identical(vctrs::vec_rbind(sf1, sf2), exp)
  expect_identical(bind_rows(sf1, sf2), st_as_sf(exp))

  exp = data_frame(
    y = c("", NA, NA, ""),
    x = c(0, 1, 0, 0),
    geo2 = sfc2[c(1, NA, NA, 1)],
    geo1 = sfc1[c(NA, 1:2, NA)]
  )
  expect_identical(vctrs::vec_rbind(sf2, sf1, sf2), exp)
  expect_identical(bind_rows(sf2, sf1, sf2), st_as_sf(exp))
})

test_that("can combine sf and tibble", {
  sfc1 = st_sfc(st_point(1:2), st_point(3:4))
  sfc2 = st_sfc(st_linestring(matrix(1:4, 2)))

  sf1 = st_sf(x = c(TRUE, FALSE), geo1 = sfc1)
  sf2 = st_sf(y = "", geo2 = sfc2, x = 0, stringsAsFactors = FALSE)

  out = vctrs::vec_rbind(sf2, data.frame(x = 1))
  exp = data_frame(
    y = c("", NA),
    x = c(0, 1),
    geo2 = sfc2[c(1L, NA)]
  )
  expect_identical(out, exp)

  out = vctrs::vec_rbind(sf2, tibble::tibble(x = 1))
  expect_identical(out, exp)

  out = vctrs::vec_rbind(tibble::tibble(x = 1), sf2)
  exp = data_frame(
    x = c(1, 0),
    y = c(NA, ""),
    geo2 = sfc2[c(NA, 1L)]
  )
  expect_identical(out, exp)
})

# https://github.com/r-spatial/sf/issues/1390
test_that("can combine sfc lists", {
  ls <- st_linestring(matrix(1:3, ncol = 3))

  sfc <- st_sfc(ls)
  expect_identical(vec_c(sfc, sfc), c(sfc, sfc))

  sf <- st_as_sf(data.frame(id = 1, geometry = sfc))

  # Currently returns a bare data frame because of the workaround for
  # the `c()` fallback sentinels
  expect_identical(vec_rbind(sf, sf), new_data_frame(rbind(sf, sf)))
  expect_identical(vec_rbind(sf, sf, sf), new_data_frame(rbind(sf, sf, sf)))
})

test_that("can combine sfc lists with unspecified chunks", {
  point <- st_point(1:2)
  out <- vec_c(c(NA, NA), st_sfc(point), NA)
  expect_identical(out, st_sfc(NA, NA, point, NA))

  multipoint <- st_multipoint(matrix(1:4, 2))
  x <- st_sfc(point)
  y <- st_sfc(multipoint, multipoint)
  out <- vec_rbind(
    data_frame(x = x),
    data_frame(y = y)
  )
  expect_identical(
    out,
    data_frame(
      x = st_sfc(point, NA, NA),
      y = st_sfc(NA, multipoint, multipoint)
    )
  )
})

test_that("`n_empty` attribute of `sfc` vectors is restored", {
  pt1 = st_sfc(st_point(c(NA_real_, NA_real_)))
  pt2 = st_sfc(st_point(0:1))

  x = c(pt1, pt2)
  expect_identical(attr(vctrs::vec_slice(x, 1), "n_empty"), 1L)
  expect_identical(attr(vctrs::vec_slice(x, 2), "n_empty"), 0L)

  combined = vctrs::vec_c(pt1, pt2, pt1)
  expect_length(combined, 3)
  expect_identical(attr(combined, "n_empty"), 2L)
})

test_that("bbox attributes of `sfc` vectors are restored", {
  pt1 = st_sfc(st_point(c(1L, 2L)))
  pt2 = st_sfc(st_point(c(10L, 20L)))

  x = c(pt1, pt2)
  expect_identical(st_bbox(vctrs::vec_slice(x, 1)), st_bbox(pt1))
  expect_identical(st_bbox(vctrs::vec_slice(x, 2)), st_bbox(pt2))

  combined = vctrs::vec_c(pt1, pt2)
  expect_identical(st_bbox(x), st_bbox(combined))
})

test_that("`precision` and `crs` attributes of `sfc` vectors are restored", {
  x = st_sfc(st_point(c(pi, pi)), precision = 1e-4, crs = 3857)
  out = vctrs::vec_slice(x, 1)
  expect_identical(st_precision(x), st_precision(out))
  expect_identical(st_crs(x), st_crs(out))
})

test_that("`precision` attributes of `sfc` vectors are combined", {
  x = st_sfc(st_point(c(pi, pi)), precision = 1e-4, crs = 3857)
  y = st_sfc(st_point(c(0, 0)), precision = 1e-4, crs = 3857)

  out = vctrs::vec_c(x, y)
  expect_identical(st_precision(x), st_precision(out))

  # These used to be errors before we fell back to c()
  y = st_sfc(st_point(c(0, 0)), precision = 1e-2, crs = 3857)
  expect_identical(vctrs::vec_c(x, y), c(x, y))
  # expect_error(vctrs::vec_c(x, y), "precisions not equal")
})

test_that("`crs` attributes of `sfc` vectors must be the same", {
  x = st_sfc(st_point(c(pi, pi)), precision = 1e-4, crs = 3857)
  y = st_sfc(st_point(c(0, 0)), precision = 1e-4, crs = 3857)

  out = vctrs::vec_c(x, y)
  expect_identical(st_crs(x), st_crs(out))

  # Error on different `crs` comes from sf as of 1.0-10
  y = st_sfc(st_point(c(0, 0)), precision = 1e-4, crs = 4326)
  expect_snapshot(error = TRUE, {
    vctrs::vec_c(x, y)
  })
})

test_that("`vec_locate_matches()` works with `sfc` vectors", {
  x <- c(
    st_sfc(st_point(c(0, 0))),
    st_sfc(st_point(c(0, 1))),
    st_sfc(st_point(c(2, 1))),
    st_sfc(c(st_point(c(0, 1)), st_point(c(0, 1))))
  )

  y <- c(
    st_sfc(c(st_point(c(0, 1)), st_point(c(0, 1)))),
    st_sfc(st_point(c(0, 0))),
    st_sfc(st_point(c(0, 3))),
    st_sfc(st_point(c(0, 0))),
    st_sfc(st_point(c(0, 1)))
  )

  out <- vec_locate_matches(x, y)
  expect_identical(out$needles, c(1L, 1L, 2L, 3L, 4L))
  expect_identical(out$haystack, c(2L, 4L, 5L, NA, 1L))
})

test_that("`vec_rbind()` doesn't leak common type fallbacks (#1331)", {
  sf = st_sf(id = 1:2, geo = st_sfc(st_point(c(1, 1)), st_point(c(2, 2))))

  expect_equal(
    vec_rbind(sf, sf),
    data_frame(id = rep(1:2, 2), geo = rep(sf$geo, 2))
  )

  expect_equal(
    vec_rbind(sf, sf, .names_to = "id"),
    data_frame(id = rep(1:2, each = 2), geo = rep(sf$geo, 2))
  )
})
