#' @importFrom digest digest
NULL

#' @keywords internal
#' @noRd
rx_http_client <- function() {
  httr2::request(getOption("rxref.base_url")) |>
    httr2::req_user_agent(getOption("rxref.user_agent"))
}


#' @keywords internal
#' @noRd
rx_sleep <- function() {
  delay <- getOption("rxref.rate_delay", 0)
  if (isTRUE(delay > 0)) Sys.sleep(delay)
}

#' Perform an RxNav/RxClass request and parse JSON
#'
#' @param req An httr2 request object.
#' @param service Character label for the service, e.g. "RxNorm" or "RxClass".
#'
#' @return Parsed JSON as a list.
#'
#' @keywords internal
#' @noRd
rx_perform_json <- function(req, service = "RxNav") {
  resp <- tryCatch(
    httr2::req_perform(req),
    error = function(e) {
      rx_abort_api(
        paste(
          service, "API request failed.",
          "rxref could not connect to the API.",
          "Check your internet connection and try again.",
          sep = "\n"
        ),
        class = "rxref_connection_error",
        parent = e
      )
    }
  )

  status <- httr2::resp_status(resp)

  if (identical(status, 429L)) {
    rx_abort_api(
      paste(
        service, "API request failed with status 429.",
        "The request may have been rate-limited.",
        "Try increasing `rate_delay` or retrying later.",
        sep = "\n"
      ),
      class = "rxref_rate_limit_error"
    )
  }

  if (identical(status, 404L)) {
    rx_abort_api(
      paste(
        service, "API request failed with status 404.",
        "The requested endpoint or resource was not found.",
        sep = "\n"
      ),
      class = "rxref_not_found_error"
    )
  }

  if (status >= 500L) {
    rx_abort_api(
      paste(
        service, "API request failed with status", status, ".",
        "This appears to be a temporary server-side issue.",
        "Please retry later.",
        sep = "\n"
      ),
      class = "rxref_server_error"
    )
  }

  if (status >= 400L) {
    rx_abort_api(
      paste(
        service, "API request failed with status", status, ".",
        "The API returned an unsuccessful response.",
        sep = "\n"
      ),
      class = "rxref_http_error"
    )
  }

  txt <- tryCatch(
    httr2::resp_body_string(resp),
    error = function(e) {
      msg <- conditionMessage(e)

      if (grepl("empty body", msg, ignore.case = TRUE)) {
        rx_abort_api(
          paste(
            service, "API response was empty.",
            "The API returned an empty response body.",
            sep = "\n"
          ),
          class = "rxref_empty_response_error",
          parent = e
        )
      }

      rx_abort_api(
        paste(
          service, "API response could not be read.",
          "The API returned a response, but rxref could not read the response body.",
          sep = "\n"
        ),
        class = "rxref_response_error",
        parent = e
      )
    }
  )

  if (!nzchar(txt)) {
    rx_abort_api(
      paste(
        service, "API response was empty.",
        "The API returned an empty response body.",
        sep = "\n"
      ),
      class = "rxref_empty_response_error"
    )
  }

  tryCatch(
    jsonlite::fromJSON(txt, simplifyVector = FALSE),
    error = function(e) {
      rx_abort_api(
        paste(
          service, "API response could not be parsed.",
          "The API returned malformed or unexpected JSON.",
          "Please retry later.",
          sep = "\n"
        ),
        class = "rxref_json_error",
        parent = e
      )
    }
  )
}

# helpers for rx_get_json() caching
.rxref_memo_env <- new.env(parent = emptyenv())

.rxref_get_cache <- function() {
  opt <- getOption("rxref.cache")

  if (inherits(opt, "cachem")) {
    return(opt)
  }

  cachem::cache_mem()
}

.make_rx_get_json <- function(cache) {
  memoise::memoise(
    function(path, query = list()) {
      rx_sleep()

      path_json <- if (grepl("\\.json$", path)) {
        path
      } else {
        paste0(path, ".json")
      }

      req <- rx_http_client() |>
        httr2::req_url_path_append(path_json) |>
        httr2::req_url_query(!!!query, .multi = "explode")

      rx_perform_json(req, service = "RxNorm")
    },
    cache = cache
  )
}

#' @keywords internal
#' @noRd
rx_get_json <- function(path, query = list()) {
  cache <- .rxref_get_cache()

  if (
    is.null(.rxref_memo_env$rx_get_json) ||
    !identical(cache, .rxref_memo_env$rx_get_json_cache)
  ) {
    .rxref_memo_env$rx_get_json <- .make_rx_get_json(cache)
    .rxref_memo_env$rx_get_json_cache <- cache
  }

  .rxref_memo_env$rx_get_json(path = path, query = query)
}

#' @keywords internal
#' @noRd
rxclass_http_client <- function() {
  httr2::request(
    getOption(
      "rxref.rxclass_base_url",
      "https://rxnav.nlm.nih.gov/REST/rxclass"
    )
  ) |>
    httr2::req_user_agent(getOption("rxref.user_agent"))
}

#' @keywords internal
#' @noRd
.rxclass_collapse_query <- function(x) {
  if (is.null(x)) return(NULL)
  if (length(x) == 0) return(NULL)

  paste(x, collapse = " ")
}

.make_rxclass_get_json <- function(cache) {
  memoise::memoise(
    function(path, query = list()) {
      rx_sleep()

      path_json <- if (grepl("\\.json$", path)) {
        path
      } else {
        paste0(path, ".json")
      }

      req <- rxclass_http_client() |>
        httr2::req_url_path_append(path_json) |>
        httr2::req_url_query(!!!query, .multi = "explode")

      rx_perform_json(req, service = "RxClass")
    },
    cache = cache
  )
}

#' @keywords internal
#' @noRd
rxclass_get_json <- function(path, query = list()) {
  cache <- .rxref_get_cache()

  if (
    is.null(.rxref_memo_env$rxclass_get_json) ||
    !identical(cache, .rxref_memo_env$rxclass_get_json_cache)
  ) {
    .rxref_memo_env$rxclass_get_json <- .make_rxclass_get_json(cache)
    .rxref_memo_env$rxclass_get_json_cache <- cache
  }

  .rxref_memo_env$rxclass_get_json(path = path, query = query)
}

#' @keywords internal
#' @noRd
null2chr <- function(x) {
  if (is.null(x) || length(x) == 0) return(NA_character_)
  as.character(x[[1]])
}


# tidy helpers --------------------------------------------------------------

#' @keywords internal
#' @noRd
.as_tibble <- function(x) tibble::as_tibble(x, .name_repair = "unique")

#' @keywords internal
#' @noRd
null2na <- function(x) if (is.null(x)) NA else x

#' @keywords internal
#' @noRd
vec_recycle_len <- function(x, n) vctrs::vec_recycle(x, n)

#' @keywords internal
#' @noRd
is_rxcui <- function(x) {
  if (!is.character(x) || length(x) != 1L || is.na(x)) return(FALSE)

  # Only digits
  if (!grepl("^[0-9]+$", x)) return(FALSE)

  # If it's 10 or 11 digits, treat as NDC-ish, not RxCUI
  !nchar(x) %in% c(10L, 11L)
}

#' @keywords internal
#' @noRd
is_ndcish <- function(x) {
  if (!is.character(x) || length(x) != 1L || is.na(x)) return(FALSE)

  digits <- gsub("[^0-9]", "", x)

  grepl("^[0-9]{10,11}$", digits)
}


#' @keywords internal
#' @noRd
.ndc_parts_from_string <- function(x) {
  if (!is.character(x) || length(x) != 1L || is.na(x)) {
    return(list(
      labeler = NA_character_,
      product = NA_character_,
      package = NA_character_,
      raw = x
    ))
  }

  raw <- x
  x <- trimws(x)

  # Preserve hyphenated structure if present
  cleaned <- gsub("[^0-9-]", "", x)

  if (grepl("^\\d+-\\d+-\\d+$", cleaned)) {
    p <- strsplit(cleaned, "-", fixed = TRUE)[[1]]

    return(list(
      labeler = p[[1]],
      product = p[[2]],
      package = p[[3]],
      raw = raw
    ))
  }

  digits <- gsub("[^0-9]", "", x)

  if (!grepl("^[0-9]{10,11}$", digits)) {
    return(list(
      labeler = NA_character_,
      product = NA_character_,
      package = NA_character_,
      raw = raw
    ))
  }

  # If 11 digits, assume already normalized 5-4-2
  if (nchar(digits) == 11L) {
    return(list(
      labeler = substr(digits, 1L, 5L),
      product = substr(digits, 6L, 9L),
      package = substr(digits, 10L, 11L),
      raw = raw
    ))
  }

  # If 10 digits and not hyphenated, grouping cannot be known reliably
  list(
    labeler = NA_character_,
    product = NA_character_,
    package = NA_character_,
    raw = raw
  )
}

#' @keywords internal
#' @noRd
ndc_to_11 <- function(ndc) {
  stopifnot(is.character(ndc))

  purrr::map_chr(ndc, function(x) {
    if (is.na(x) || !nzchar(x)) {
      return(NA_character_)
    }

    x <- trimws(x)

    # If already an 11-digit NDC, return digits only
    digits_only <- gsub("[^0-9]", "", x)

    if (nchar(digits_only) == 11 && !grepl("-", x)) {
      return(digits_only)
    }

    # Handle hyphenated FDA 10-digit formats
    parts <- strsplit(x, "-", fixed = TRUE)[[1]]

    if (length(parts) == 3) {
      parts <- trimws(parts)

      labeler <- parts[[1]]
      product <- parts[[2]]
      package <- parts[[3]]

      widths <- nchar(parts)

      # 4-4-2 format: pad labeler to 5 digits
      if (identical(widths, c(4L, 4L, 2L))) {
        return(paste0(
          stringr::str_pad(labeler, width = 5, side = "left", pad = "0"),
          product,
          package
        ))
      }

      # 5-3-2 format: pad product to 4 digits
      if (identical(widths, c(5L, 3L, 2L))) {
        return(paste0(
          labeler,
          stringr::str_pad(product, width = 4, side = "left", pad = "0"),
          package
        ))
      }

      # 5-4-1 format: pad package to 2 digits
      if (identical(widths, c(5L, 4L, 1L))) {
        return(paste0(
          labeler,
          product,
          stringr::str_pad(package, width = 2, side = "left", pad = "0")
        ))
      }
    }

    # Do not infer 11-digit format from non-hyphenated 10-digit NDCs.
    # Without hyphens, the original FDA format is ambiguous, e.g.,
    # 4-4-2, 5-3-2, or 5-4-1?
    if (nchar(digits_only) == 10L && !grepl("-", x)) {
      return(NA_character_)
    }


    # Fallback: if removing punctuation gives 11 digits, use that
    if (nchar(digits_only) == 11) {
      return(digits_only)
    }

    NA_character_
  })
}

#' @keywords internal
#' @noRd
hyphenate_ndc_5_4_2 <- function(ndc) {
  if (!is.character(ndc)) {
    return(ndc)
  }

  purrr::map_chr(ndc, function(x) {
    if (is.na(x)) return(NA_character_)

    digits <- gsub("[^0-9]", "", x)

    if (!grepl("^[0-9]{11}$", digits)) {
      return(x)
    }

    paste0(
      substr(digits, 1L, 5L), "-",
      substr(digits, 6L, 9L), "-",
      substr(digits, 10L, 11L)
    )
  })
}


