.testRegExp <- "^test-.*\\.[rR]$"

.relativeTo <- function(root, path) {
  substr(path, nchar(root) + 2, nchar(path))
}

.maybeRelativeTo <- function(root, path) {
  ifelse(
    startsWith(path, root),
    .relativeTo(root, path),
    path
  )
}

purge_cache <- function() { # nolint: object_name_linter
  eapply(box:::loaded_mods, function(mod_ns) { # nolint: object_name_linter
    box:::call_hook(mod_ns, ".on_unload", mod_ns)
  }, all.names = TRUE)
  rm(list = names(box:::loaded_mods), envir = box:::loaded_mods)
}

.source_dir <- function( # nolint: object_name_linter
                        path,
                        pattern = "\\.[rR]$",
                        env = test_env(),
                        chdir = TRUE,
                        wrap = TRUE) {
  purge_cache()
}


withCallingHandlers(
  testthat::with_mock(
    testthat::auto_test("src", "tests/testthat"),
    `testthat::auto_test` = function(codePath,
                                     testPath,
                                     reporter = testthat:::default_reporter(),
                                     env = testthat:::test_env(),
                                     hash = TRUE,
                                     source_dir = .source_dir # nolint: object_name_linter
    ) {
      reporter <- testthat:::find_reporter(reporter)
      root <- normalizePath(".")
      codePath <- normalizePath(codePath)
      testPath <- normalizePath(testPath)

      # Start by loading all code and running all tests
      source_dir(codePath, env = env)
      testthat::test_dir(
        testPath,
        env = env,
        reporter = reporter$clone(deep = TRUE),
        stop_on_failure = FALSE,
        stop_on_warning = FALSE
      )

      # Next set up watcher to monitor changes
      watcher <- function(added, deleted, modified) {
        allTriggers <- normalizePath(c(added, deleted, modified))

        testsAndHelpers <- .relativeTo(testPath, allTriggers[
          testthat:::starts_with(allTriggers, testPath)
        ])
        code <- .maybeRelativeTo(root, allTriggers[
          testthat:::starts_with(allTriggers, codePath)
        ])

        .isTest <- grepl(.testRegExp, basename(testsAndHelpers))
        .testsTriggers <- normalizePath(c(added, modified))
        tests <- testsAndHelpers[.isTest & allTriggers %in% .testsTriggers]
        helpers <- testsAndHelpers[!.isTest]
        nonTests <- c(code, helpers)

        if (length(nonTests) >= 1) {
          # Rerun all tests
          if (length(code) >= 1) {
            cat(
              "Changed code: ",
              paste0(code, collapse = ", "),
              "\n"
            )
          }
          if (length(helpers) >= 1) {
            cat(
              "Changed helpers: ",
              paste0(helpers, collapse = ", "),
              "\n"
            )
          }
          if (length(code) >= 1) {
            cat("Reloading code\n")
            source_dir(codePath, env = env)
          }
          cat("Rerunning all tests\n")
          testthat::test_dir(
            testPath,
            env = env,
            reporter = reporter$clone(deep = TRUE),
            stop_on_failure = FALSE,
            stop_on_warning = FALSE
          )
        } else if (length(tests) >= 1) {
          # Rerun added or changed tests
          cat(
            "Rerunning tests: ", paste0(tests, collapse = ", "), "\n"
          )
          testthat:::test_files(
            test_dir = testPath,
            test_paths = tests,
            test_package = NULL,
            env = env,
            reporter = reporter$clone(deep = TRUE),
            stop_on_failure = FALSE,
            stop_on_warning = FALSE
          )
        }

        TRUE
      }
      watch(c(codePath, testPath), watcher, hash = hash)
    },
    `testthat:::dir_state` = function(path, pattern = NULL, hash = TRUE) {
      files <- list.files(path, pattern, full.names = TRUE, recursive = TRUE)
      if (hash) {
        fileStates <- vapply(files, testthat:::safe_digest, character(1))
      } else {
        fileStates <- stats::setNames(file.info(files)$mtime, files)
      }
      fileStates[!is.na(fileStates)]
    },
    `testthat::find_test_scripts` = function(path,
                                             filter = NULL,
                                             invert = FALSE,
                                             ...,
                                             full.names = TRUE, # nolint: object_name_linter
                                             start_first = NULL # nolint: object_name_linter
    ) {
      files <- list.files(
        path, .testRegExp,
        full.names = TRUE, recursive = TRUE
      )
      files <- lapply(files, \(filepath) .maybeRelativeTo(path, filepath))
      files <- testthat:::filter_test_scripts(files, filter, invert, ...)
      testthat:::order_test_scripts(files, start_first)
    }
  ),
  warning = \(cond) {
    if (
      startsWith(
        cond$message,
        "`with_mock()` was deprecated "
      )
    ) {
      invokeRestart("muffleWarning")
    }
  }
)