#' Namespace linter
#'
#' Check for missing packages and symbols in namespace calls.
#' Note that using `check_exports=TRUE` or `check_nonexports=TRUE` will load packages used in user code so it could
#' potentially change the global state.
#'
#' @param check_exports Check if `symbol` is exported from `namespace` in `namespace::symbol` calls.
#' @param check_nonexports Check if `symbol` exists in `namespace` in `namespace:::symbol` calls.
#'
#' @examples
#' # will produce lints
#' lint(
#'   text = "xyzxyz::sd(c(1, 2, 3))",
#'   linters = namespace_linter()
#' )
#'
#' lint(
#'   text = "stats::ssd(c(1, 2, 3))",
#'   linters = namespace_linter()
#' )
#'
#' # okay
#' lint(
#'   text = "stats::sd(c(1, 2, 3))",
#'   linters = namespace_linter()
#' )
#'
#' lint(
#'   text = "stats::ssd(c(1, 2, 3))",
#'   linters = namespace_linter(check_exports = FALSE)
#' )
#'
#' lint(
#'   text = "stats:::ssd(c(1, 2, 3))",
#'   linters = namespace_linter(check_nonexports = FALSE)
#' )
#'
#' @evalRd rd_tags("namespace_linter")
#' @seealso [linters] for a complete list of linters available in lintr.
#' @export
namespace_linter <- function(check_exports = TRUE, check_nonexports = TRUE) {
  Linter(linter_level = "file", function(source_expression) {
    xml <- source_expression$full_xml_parsed_content

    ns_nodes <- xml_find_all_(xml, "//NS_GET | //NS_GET_INT")

    if (length(ns_nodes) == 0L) {
      return(list())
    }

    ## Case 1: pkg is uninstalled in pkg::foo

    package_nodes <- xml_find_all_(ns_nodes, "preceding-sibling::*[1]")
    packages <- get_r_string(package_nodes)

    lints <- list()

    # run here, not in the factory, to allow for run- vs. "compile"-time differences in available packages
    installed_packages <- .packages(all.available = TRUE)
    installed <- packages %in% installed_packages

    if (!all(installed)) {
      lints <- c(lints, xml_nodes_to_lints(
        package_nodes[!installed],
        source_expression = source_expression,
        lint_message = sprintf("Package '%s' is not installed.", packages[!installed]),
        type = "warning"
      ))

      ns_nodes <- ns_nodes[installed]
      packages <- packages[installed]
      package_nodes <- package_nodes[installed]
    }

    if (length(packages) == 0L) {
      return(lints)
    }

    ## Case 2/3/4/5: problems with foo in pkg::foo / pkg:::foo

    # run here, not in the factory, to allow for run- vs. "compile"-time differences in package structure
    namespaces <- lapply(packages, \(package) tryCatch(getNamespace(package), packageNotFoundError = identity))
    failed_namespace <- vapply(namespaces, inherits, "packageNotFoundError", FUN.VALUE = logical(1L))

    # nocov start
    if (any(failed_namespace)) {
      cli_abort_internal("Failed to retrieve namespaces for one or more of the packages used with `::` or `:::`. ")
    }
    # nocov end

    ns_get <- xml_text(ns_nodes) == "::"
    symbol_nodes <- xml_find_all_(ns_nodes, "following-sibling::*[1]")
    symbols <- get_r_string(symbol_nodes)
    symbols <- sub("^`(.*)`$", "\\1", symbols)

    if (check_nonexports) {
      lints <- c(lints, build_ns_get_int_lints(
        packages[!ns_get],
        symbols[!ns_get],
        symbol_nodes[!ns_get],
        namespaces[!ns_get],
        source_expression
      ))
    }

    if (check_exports) {
      lints <- c(lints, build_ns_get_lints(
        packages[ns_get],
        symbols[ns_get],
        symbol_nodes[ns_get],
        namespaces[ns_get],
        source_expression
      ))
    }

    pkg_path <- find_package(source_expression$filename)
    ns_imports <- namespace_imports(pkg_path)
    if (nrow(ns_imports) == 0L) {
      return(lints)
    }

    is_imported <- vapply(
      seq_along(symbols),
      \(ii) any(ns_imports$pkg == packages[ii] & ns_imports$fun == symbols[ii]),
      logical(1L)
    )
    if (any(is_imported)) {
      lints <- c(lints, xml_nodes_to_lints(
        symbol_nodes[is_imported],
        source_expression = source_expression,
        lint_message = sprintf(
          "Don't use `%s` to access %s, which is already imported from %s.",
          ifelse(ns_get[is_imported], "::", ":::"), symbols[is_imported], packages[is_imported]
        ),
        type = "warning"
      ))
    }

    lints
  })
}

namespace_symbols <- function(ns, exported = TRUE) {
  if (exported) {
    c(getNamespaceExports(ns), names(.getNamespaceInfo(ns, "lazydata")))
  } else {
    ls(ns, all.names = TRUE)
  }
}
is_in_pkg <- function(symbols, namespaces, exported = TRUE) {
  vapply(
    seq_along(symbols),
    \(ii) symbols[[ii]] %in% namespace_symbols(namespaces[[ii]], exported = exported),
    logical(1L)
  )
}

build_ns_get_int_lints <- function(packages, symbols, symbol_nodes, namespaces, source_expression) {
  ## Case 2: foo does not exist in pkg:::foo
  non_symbols <- !is_in_pkg(symbols, namespaces, exported = FALSE)
  non_symbols_lints <- xml_nodes_to_lints(
    symbol_nodes[non_symbols],
    source_expression = source_expression,
    lint_message = sprintf("'%s' does not exist in {%s}.", symbols[non_symbols], packages[non_symbols]),
    type = "warning"
  )

  packages <- packages[!non_symbols]
  symbols <- symbols[!non_symbols]
  symbol_nodes <- symbol_nodes[!non_symbols]
  namespaces <- namespaces[!non_symbols]

  ## Case 3: foo is already exported pkg:::foo
  exported <- is_in_pkg(symbols, namespaces)
  exported_lints <- xml_nodes_to_lints(
    symbol_nodes[exported],
    source_expression = source_expression,
    lint_message =
      sprintf("Don't use `:::` to access %s, which is exported from %s.", symbols[exported], packages[exported]),
    type = "warning"
  )

  c(non_symbols_lints, exported_lints)
}

build_ns_get_lints <- function(packages, symbols, symbol_nodes, namespaces, source_expression) {
  ## Case 4: foo is not an export in pkg::foo
  unexported <- !is_in_pkg(symbols, namespaces)
  xml_nodes_to_lints(
    symbol_nodes[unexported],
    source_expression = source_expression,
    lint_message = sprintf("'%s' is not exported from {%s}.", symbols[unexported], packages[unexported]),
    type = "warning"
  )
}
