# Query to service service-
#' Build a search URL for the RSS service
#'
#' This internal helper constructs a URL to query for the French Ministry
#' of Culture's "Atlas du Patrimoine" RSS service.
#' The URL filters data using a bounding box (`extent`) and an
#' INSEE department code (`insee_dep`).
#'
#' @param extent A named list with elements `left`, `bottom`, `right`, `top`
#' defining the bounding box coordinates.
#' @param insee_dep A character or numeric INSEE department code.
#'
#' @return A character string containing the full URL to query the service.
#'
#' @importFrom utils URLencode
#'
#' @keywords internal
#'
ids_url_build <- function(extent, insee_dep) {
  # Validate input structure
  required <- c("left", "bottom", "right", "top")
  missing <- setdiff(required, names(extent))
  if (length(missing) > 0) {
    stop("Missing extent element(s): ", paste(missing, collapse = ", "), call. = FALSE)
  }

  # Base URL
  base_url <- "http://atlas.patrimoines.culture.fr/geosource/srv/fr/rss.search?"

  # Build query parameters
  query_params <- list(
    "_dc" = as.character(as.numeric(Sys.time()) * 1000),
    from = 1,
    to = 30,
    sortby = "MCC",
    pertinentScaleLevel = 1,
    georss = "simple",
    westBL = extent$left,
    eastBL = extent$right,
    southBL = extent$bottom,
    northBL = extent$top,
    geoForm = "BBOX",
    geoID = paste0("DEP_", insee_dep),
    themekeywords = "Protection"
  )

  # Encode query string
  query_string <- paste(
    names(query_params),
    vapply(query_params, function(x) URLencode(as.character(x), reserved = TRUE), character(1)),
    sep = "=",
    collapse = "&"
  )

  # Combine with proxy URL
  paste0(
    "http://atlas.patrimoines.culture.fr/atlas/trunk/proxy_ign.php?url=",
    URLencode(paste0(base_url, query_string), reserved = TRUE)
  )
}

#' Download and parse heritage metadata from a URL
#'
#' This internal helper performs an HTTP GET request to the given URL
#' (typically generated by [ids_url_build()]) and parses the RSS XML
#' response into a structured `data.frame`.
#'
#' @param url `Character.` The complete request URL.
#' @param timeout `Numeric.` Request timeout in seconds (default = `60`).
#' @return
#' A `data.frame` with columns:
#' \describe{
#'   \item{id}{Numeric identifier extracted from the GUID.}
#'   \item{title}{Record title as published in the service.}
#'   \item{guid}{Full GUID (unique resource identifier).}
#' }
#' Returns an empty `data.frame` if the request fails or no items are found.
#'
#' @importFrom httr2 request req_timeout req_perform resp_status resp_body_string req_retry
#' @importFrom xml2 read_xml xml_find_all xml_text
#'
#' @keywords internal
#'
ids_download <- function(url, timeout = 60) {
  # Build request
  req <- httr2::request(url) |>
    httr2::req_timeout(timeout) |>
    httr2::req_retry(
      max_tries = 2,
      backoff = ~5,
      is_transient = function(resp) {
        httr2::resp_status(resp) >= 500
      }
    ) |>
    quiet()

  # Perform with retry
  res <- tryCatch(
    httr2::req_perform(req),
    error = function(e) {
      warning("Request failed: ", e$message)
      data.frame()
    }
  )

  # Check response
  if (is.null(res) || httr2::resp_status(res) != 200) {
    warning("Invalid or empty response.")
    return(data.frame())
  }

  # Parse XML
  xml_txt <- httr2::resp_body_string(res)

  # Retrieve doc
  doc <- tryCatch(
    xml2::read_xml(xml_txt),
    error = function(e) {
      warning("XML parsing failed: ", e$message)
      return(NULL)
    }
  )
  if (is.null(doc)) return(data.frame())

  # Retrieve items
  items <- xml2::xml_find_all(doc, ".//item")
  if (length(items) == 0) {
    warning("No items found.")
    return(data.frame())
  }

  # Extract data
  rows <- lapply(items, function(item) {

    title <- xml2::xml_text(xml2::xml_find_first(item, "./title"))
    guid  <- xml2::xml_text(xml2::xml_find_first(item, "./guid"))

    id <- sub(".*MD_([0-9]+).*", "\\1", guid)

    data.frame(
      id = id,
      title = title,
      guid = guid,
      stringsAsFactors = FALSE
    )
  })

  df <- do.call(rbind, rows)

  if (nrow(df) == 0 || all(is.na(df$id))) {
    warning("No valid IDs extracted.")
    return(data.frame())
  }

  return(df)
}


#' Determine internal codes from IDs titles
#'
#' This internal function converts IDs tiles into their corresponding
#' internal codes (e.g., "IMMH", "PAMH").
#' It matches based on predefined keyword patterns and chooses the most
#' specific code when multiple patterns match.
#'
#' @param x `character` vector of IDs titles.
#'
#' @return `character` vector of internal codes corresponding to each input IDs titles.
#' Returns `NA` if no pattern matches.
#'
#' @keywords internal
#'
ids_to_codes <- function(x) {
  # Load patterns from internal data
  patterns <- heritage_patterns

  # Internal helper to find the best matching code for a given description
  find_code <- function(text) {
    matches <- character(0)
    matched_lengths <- integer(0)

    for (code in names(patterns)) {
      pats <- patterns[[code]]
      hit <- sapply(pats, grepl, text, ignore.case = TRUE)
      if (any(hit)) {
        # Keep track of matching code and length of the longest matching pattern
        longest <- max(nchar(pats[hit]))
        matches <- c(matches, code)
        matched_lengths <- c(matched_lengths, longest)
      }
    }

    if (length(matches) == 0) return(NA_character_)
    # Select the code with the longest matching pattern (more specific)
    matches[which.max(matched_lengths)]
  }

  # Apply to each element of the input vector
  sapply(x, find_code, USE.NAMES = FALSE)
}
