test_that("empty input returns init or error", {
  expect_snapshot(reduce(list()), error = TRUE)

  expect_equal(reduce(list(), `+`, .init = 0), 0)
})

test_that("first/value value used as first value", {
  expect_equal(reduce(c(1, 1), `+`), 2)
  expect_equal(reduce(c(1, 1), `+`, .init = 1), 3)
})

test_that("length 1 argument reduced with init", {
  expect_equal(reduce(1, `+`, .init = 1), 2)
})

test_that("direction of reduce determines how generated trees lean", {
  expect_identical(reduce(1:4, list), list(list(list(1L, 2L), 3L), 4L))
  expect_identical(
    reduce(1:4, list, .dir = "backward"),
    list(1L, list(2L, list(3L, 4L)))
  )
})

test_that("can shortcircuit reduction with done()", {
  x <- c(TRUE, TRUE, FALSE, TRUE, TRUE)
  out <- reduce(x, ~ if (.y) c(.x, "foo") else done(.x), .init = NULL)
  expect_identical(out, c("foo", "foo"))

  # Empty done box yields the same value as returning the
  # result-so-far (the last value) in a done box
  out2 <- reduce(x, ~ if (.y) c(.x, "foo") else done(), .init = NULL)
  expect_identical(out2, out)
})

test_that("reduce() forces arguments (#643)", {
  compose <- function(f, g) function(x) f(g(x))
  expect_identical(reduce(list(identity, identity), compose)(1), 1)
})


# accumulate --------------------------------------------------------------

test_that("accumulate passes arguments to function", {
  tt <- c("a", "b", "c")

  expect_equal(accumulate(tt, paste, sep = "."), c("a", "a.b", "a.b.c"))
  expect_equal(
    accumulate(tt, paste, sep = ".", .dir = "backward"),
    c("a.b.c", "b.c", "c")
  )

  expect_equal(
    accumulate(tt, paste, sep = ".", .init = "z"),
    c("z", "z.a", "z.a.b", "z.a.b.c")
  )
  expect_equal(
    accumulate(tt, paste, sep = ".", .dir = "backward", .init = "z"),
    c("a.b.c.z", "b.c.z", "c.z", "z")
  )
})

test_that("accumulate keeps input names", {
  input <- set_names(1:26, letters)
  expect_identical(accumulate(input, sum), set_names(cumsum(1:26), letters))
  expect_identical(
    accumulate(input, sum, .dir = "backward"),
    set_names(rev(cumsum(rev(1:26))), rev(letters))
  )
})

test_that("accumulate keeps input names when init is supplied", {
  expect_identical(accumulate(1:2, c, .init = 0L), list(0L, 0:1, 0:2))
  expect_identical(
    accumulate(0:1, c, .init = 2L, .dir = "backward"),
    list(0:2, 1:2, 2L)
  )

  expect_identical(
    accumulate(c(a = 1L, b = 2L), c, .init = 0L),
    list(.init = 0L, a = 0:1, b = 0:2)
  )
  expect_identical(
    accumulate(c(a = 0L, b = 1L), c, .init = 2L, .dir = "backward"),
    list(b = 0:2, a = 1:2, .init = 2L)
  )
})

test_that("can terminate accumulate() early", {
  tt <- c("a", "b", "c")
  paste2 <- function(x, y) {
    out <- paste(x, y, sep = ".")
    if (x == "b" || y == "b") {
      done(out)
    } else {
      out
    }
  }

  expect_equal(accumulate(tt, paste2), c("a", "a.b"))
  expect_equal(accumulate(tt, paste2, .dir = "backward"), c("b.c", "c"))

  expect_equal(accumulate(tt, paste2, .init = "z"), c("z", "z.a", "z.a.b"))
  expect_equal(
    accumulate(tt, paste2, .dir = "backward", .init = "z"),
    c("b.c.z", "c.z", "z")
  )
})

test_that("can terminate accumulate() early with an empty box", {
  tt <- c("a", "b", "c")
  paste2 <- function(x, y) {
    out <- paste(x, y, sep = ".")
    if (x == "b" || y == "b") {
      done()
    } else {
      out
    }
  }

  expect_equal(accumulate(tt, paste2), "a")
  expect_equal(accumulate(tt, paste2, .dir = "backward"), "c")

  expect_equal(accumulate(tt, paste2, .init = "z"), c("z", "z.a"))
  expect_equal(
    accumulate(tt, paste2, .dir = "backward", .init = "z"),
    c("c.z", "z")
  )

  # Init value is always included, even if done at first iteration
  expect_equal(accumulate(c("b", "c"), paste2), "b")
})

test_that("accumulate() forces arguments (#643)", {
  compose <- function(f, g) function(x) f(g(x))
  fns <- accumulate(list(identity, identity), compose)
  expect_true(every(fns, function(f) identical(f(1), 1)))
})

test_that("accumulate() uses vctrs to simplify results", {
  out <- list("foo", factor("bar")) |> accumulate(~.y)
  expect_identical(out, c("foo", "bar"))
})

test_that("accumulate() does not fail when input can't be simplified", {
  expect_identical(accumulate(list(1L, 2:3), ~.y), list(1L, 2:3))
  expect_identical(accumulate(list(1, "a"), ~.y), list(1, "a"))
})

test_that("accumulate() does fail when simpification is required", {
  expect_snapshot(accumulate(list(1, "a"), ~.y, .simplify = TRUE), error = TRUE)
})

# reduce2 -----------------------------------------------------------------

test_that("basic application works", {
  paste2 <- function(x, y, sep) paste(x, y, sep = sep)

  x <- c("a", "b", "c")
  expect_equal(reduce2(x, c("-", "."), paste2), "a-b.c")
  expect_equal(reduce2(x, c(".", "-", "."), paste2, .init = "x"), "x.a-b.c")
})

test_that("requires equal length vectors", {
  expect_snapshot(reduce2(1:3, 1, `+`), error = TRUE)
})

test_that("requires init if `.x` is empty", {
  expect_snapshot(reduce2(list()), error = TRUE)
})

test_that("reduce returns original input if it was length one", {
  x <- list(c(0, 1), c(2, 3), c(4, 5))
  expect_equal(reduce(x[1], paste), x[[1]])
})

test_that("can shortcircuit reduce2() with done()", {
  x <- c(TRUE, TRUE, FALSE, TRUE, TRUE)
  out <- reduce2(x, 1:5, ~ if (.y) c(.x, "foo") else done(.x), .init = NULL)
  expect_identical(out, c("foo", "foo"))
})

test_that("reduce2() forces arguments (#643)", {
  compose <- function(f, g, ...) function(x) f(g(x))
  fns <- reduce2(list(identity, identity), "foo", compose)
  expect_identical(fns(1), 1)
})

# accumulate2 -------------------------------------------------------------

test_that("basic accumulate2() works", {
  paste2 <- function(x, y, sep) paste(x, y, sep = sep)

  x <- c("a", "b", "c")
  expect_equal(accumulate2(x, c("-", "."), paste2), c("a", "a-b", "a-b.c"))
  expect_equal(
    accumulate2(x, c(".", "-", "."), paste2, .init = "x"),
    c("x", "x.a", "x.a-b", "x.a-b.c")
  )
})

test_that("can terminate accumulate2() early", {
  paste2 <- function(x, y, sep) {
    out <- paste(x, y, sep = sep)
    if (y == "b") {
      done(out)
    } else {
      out
    }
  }

  x <- c("a", "b", "c")
  expect_equal(accumulate2(x, c("-", "."), paste2), c("a", "a-b"))
  expect_equal(
    accumulate2(x, c(".", "-", "."), paste2, .init = "x"),
    c("x", "x.a", "x.a-b")
  )
})

test_that("accumulate2() forces arguments (#643)", {
  compose <- function(f, g, ...) function(x) f(g(x))
  fns <- accumulate2(list(identity, identity), "foo", compose)
  expect_true(every(fns, function(f) identical(f(1), 1)))
})
