#' REFT package
#'
#' Root Exudate Feature Toolkit for batch PubChem matching and molecular
#' descriptor calculation from metabolomics annotation tables.
#'
#' @docType package
#' @name REFT
#' @importFrom rlang .data
NULL

#' @keywords internal
require_rcdk <- function() {
  if (!requireNamespace("rcdk", quietly = TRUE)) {
    stop(
      paste(
        "The 'rcdk' package is required for descriptor calculation but is not available.",
        "Please install Java (matching your R architecture), then install 'rJava', 'rcdk', and 'rcdklibs'."
      ),
      call. = FALSE
    )
  }
  invisible(TRUE)
}


#' Run the full REFT workflow
#'
#' Import an Excel table, clean query fields, match SMILES from PubChem,
#' calculate six molecular descriptors, and optionally write Excel outputs.
#'
#' This is the main entry point of the package. In the most common case you
#' only need to provide `input_file`. By default, no files are written;
#' set `output_dir` to explicitly request Excel outputs.
#'
#' @param input_file Path to the input Excel file.
#' @param name_col Column name for compound name. Default is `"Name"`.
#' @param other_col Column name for alternative name. Default is
#'   `"Other_name(Kegg_name)"`.
#' @param hmdb_col Column name for HMDB identifier. Default is `"HMDB_ID"`.
#' @param kegg_col Column name for KEGG identifier. Default is `"Kegg_ID"`.
#' @param output_dir Output directory. If `NULL` (default), no files are written.
#' @param output_desc_file Final descriptor Excel filename.
#' @param output_unmatched_file Unmatched records Excel filename.
#' @param output_log_file PubChem match log Excel filename.
#' @param verbose Whether to print progress. Default is `TRUE`.
#'
#' @return A named list with three data frames:
#' \describe{
#'   \item{descriptors}{final annotation table with SMILES and six descriptors}
#'   \item{unmatched}{rows that could not be matched to SMILES}
#'   \item{match_log}{unique-query matching log from PubChem}
#' }
#'
#' @examples
#' \donttest{
#' toy <- data.frame(
#'   Name = "Glutarate",
#'   `Other_name(Kegg_name)` = NA,
#'   HMDB_ID = NA,
#'   Kegg_ID = NA,
#'   check.names = FALSE
#' )
#' if (requireNamespace("rcdk", quietly = TRUE)) {
#'   input_file <- tempfile(fileext = ".xlsx")
#'   writexl::write_xlsx(toy, input_file)
#'   res <- try(reft_run(input_file, output_dir = tempdir(), verbose = FALSE),
#'              silent = TRUE)
#'   if (!inherits(res, "try-error")) head(res$descriptors)
#' }
#' }
#'
#' @export
reft_run <- function(
  input_file,
  name_col = "Name",
  other_col = "Other_name(Kegg_name)",
  hmdb_col = "HMDB_ID",
  kegg_col = "Kegg_ID",
  output_dir = NULL,
  output_desc_file = "metabolites_6_descriptors.xlsx",
  output_unmatched_file = "unmatched_smiles.xlsx",
  output_log_file = "pubchem_match_log.xlsx",
  verbose = TRUE
) {
  if (!file.exists(input_file)) {
    stop("input_file does not exist: ", input_file, call. = FALSE)
  }

  dat <- readxl::read_excel(input_file)

  if (verbose) {
    cat("Read", nrow(dat), "rows and", ncol(dat), "columns.\n")
    cat("Column names:\n")
    print(colnames(dat))
  }

  check_required_cols(dat, c(name_col, other_col, hmdb_col, kegg_col))

  dat <- dat %>%
    dplyr::mutate(
      query_name = clean_text(.data[[name_col]]),
      query_other = clean_text(.data[[other_col]]),
      query_hmdb = clean_text(.data[[hmdb_col]]),
      query_kegg = clean_text(.data[[kegg_col]])
    )

  match_df <- build_match_log(dat, verbose = verbose)

  dat2 <- dat %>%
    dplyr::left_join(
      match_df,
      by = c("query_name", "query_other", "query_kegg", "query_hmdb")
    )

  if (verbose) {
    cat("Records matched to SMILES:", sum(!is.na(dat2$SMILES)), "\n")
    cat("Records not matched to SMILES:", sum(is.na(dat2$SMILES)), "\n")
  }

  unmatched_tbl <- dat2 %>%
    dplyr::filter(is.na(.data$SMILES)) %>%
    dplyr::select(dplyr::any_of(c(
      "ID", name_col, other_col, kegg_col, hmdb_col,
      "query_name", "query_other", "query_kegg", "query_hmdb"
    )))

  require_rcdk()

  dat3 <- dat2 %>%
    dplyr::mutate(mol = purrr::map(.data$SMILES, parse_smiles_safe))

  if (verbose) {
    cat("\nCalculating six molecular descriptors...\n")
  }

  desc6_tbl <- purrr::map_dfr(dat3$mol, calc_desc6)

  out_desc6 <- dplyr::bind_cols(
    dat3 %>%
      dplyr::select(dplyr::any_of(c(
        "ID", name_col, other_col, kegg_col, hmdb_col,
        "SMILES", "matched_by", "matched_query", "pubchem_cid"
      ))),
    desc6_tbl
  )

  if (!is.null(output_dir)) {
    if (!is.character(output_dir) || length(output_dir) != 1 ||
        is.na(output_dir) || output_dir == "") {
      stop("output_dir must be NULL or a non-empty character string.", call. = FALSE)
    }
    dir.create(output_dir, showWarnings = FALSE, recursive = TRUE)
    writexl::write_xlsx(match_df, file.path(output_dir, output_log_file))
    writexl::write_xlsx(unmatched_tbl, file.path(output_dir, output_unmatched_file))
    writexl::write_xlsx(out_desc6, file.path(output_dir, output_desc_file))
    if (verbose) {
      cat("Output directory:", output_dir, "\n")
    }
  }

  if (verbose) {
    cat("\nDone.\n")
    cat("Records with successfully calculated MW:", sum(!is.na(out_desc6$MW)), "\n")
    cat("Records with failed descriptor calculation:", sum(is.na(out_desc6$MW)), "\n")
  }

  list(
    descriptors = out_desc6,
    unmatched = unmatched_tbl,
    match_log = match_df
  )
}

#' Run REFT with default column names
#'
#' A simplified wrapper around [reft_run()] for the common case where the input
#' file already uses the default column names.
#'
#' @param input_file Path to the input Excel file.
#' @param output_dir Output directory. If `NULL` (default), no files are written.
#' @param verbose Whether to print progress. Default is `TRUE`.
#'
#' @return Same as [reft_run()].
#' @examples
#' \donttest{
#' toy <- data.frame(
#'   Name = "Glutarate",
#'   `Other_name(Kegg_name)` = NA,
#'   HMDB_ID = NA,
#'   Kegg_ID = NA,
#'   check.names = FALSE
#' )
#' if (requireNamespace("rcdk", quietly = TRUE)) {
#'   input_file <- tempfile(fileext = ".xlsx")
#'   writexl::write_xlsx(toy, input_file)
#'   res <- try(reft_run_simple(input_file, output_dir = tempdir(), verbose = FALSE),
#'              silent = TRUE)
#'   if (!inherits(res, "try-error")) head(res$descriptors)
#' }
#' }
#' @export
reft_run_simple <- function(input_file, output_dir = NULL, verbose = TRUE) {
  reft_run(
    input_file = input_file,
    output_dir = output_dir,
    verbose = verbose
  )
}

#' Match SMILES from PubChem
#'
#' Batch match SMILES using Name, Other Name, KEGG ID, and HMDB ID in order.
#'
#' @param data A data frame containing query columns.
#' @param name_col Compound name column.
#' @param other_col Alternative name column.
#' @param hmdb_col HMDB ID column.
#' @param kegg_col KEGG ID column.
#'
#' @return A data frame with matching log and SMILES.
#' @examples
#' \donttest{
#' dat <- data.frame(
#'   Name = "Glutarate",
#'   `Other_name(Kegg_name)` = NA,
#'   HMDB_ID = NA,
#'   Kegg_ID = NA,
#'   check.names = FALSE
#' )
#' res <- try(reft_match_smiles(dat), silent = TRUE)
#' if (!inherits(res, "try-error")) head(res)
#' }
#' @export
reft_match_smiles <- function(
  data,
  name_col = "Name",
  other_col = "Other_name(Kegg_name)",
  hmdb_col = "HMDB_ID",
  kegg_col = "Kegg_ID"
) {
  check_required_cols(data, c(name_col, other_col, hmdb_col, kegg_col))

  data <- data %>%
    dplyr::mutate(
      query_name = clean_text(.data[[name_col]]),
      query_other = clean_text(.data[[other_col]]),
      query_hmdb = clean_text(.data[[hmdb_col]]),
      query_kegg = clean_text(.data[[kegg_col]])
    )

  build_match_log(data, verbose = FALSE)
}

#' Calculate six molecular descriptors
#'
#' @param smiles A character vector of SMILES.
#'
#' @return A tibble with six molecular descriptors.
#' @examples
#' if (requireNamespace("rcdk", quietly = TRUE)) {
#'   reft_calc_descriptors("OC(=O)CCC(=O)O")
#' }
#' @export
reft_calc_descriptors <- function(smiles) {
  require_rcdk()
  mols <- purrr::map(smiles, parse_smiles_safe)
  purrr::map_dfr(mols, calc_desc6)
}

build_match_log <- function(dat, verbose = TRUE) {
  query_tbl <- dat %>%
    dplyr::distinct(.data$query_name, .data$query_other, .data$query_kegg, .data$query_hmdb, .keep_all = TRUE)

  if (verbose) {
    cat("\nStarting PubChem matching for", nrow(query_tbl), "unique records...\n")
  }

  cache_file <- getOption("REFT.pubchem_cache_file", NULL)
  cache_env <- new.env(parent = emptyenv())
  if (!is.null(cache_file) && file.exists(cache_file)) {
    old_cache <- tryCatch(readRDS(cache_file), error = function(e) list())
    if (is.list(old_cache) && length(old_cache) > 0) {
      list2env(old_cache, envir = cache_env)
    }
  }

  match_list <- purrr::pmap(
    list(
      query_tbl$query_name,
      query_tbl$query_other,
      query_tbl$query_kegg,
      query_tbl$query_hmdb
    ),
    function(name, other, kegg, hmdb) {
      key <- paste(
        ifelse(is.na(name), "", name),
        ifelse(is.na(other), "", other),
        ifelse(is.na(kegg), "", kegg),
        ifelse(is.na(hmdb), "", hmdb),
        sep = "||"
      )
      if (exists(key, envir = cache_env, inherits = FALSE)) {
        return(get(key, envir = cache_env, inherits = FALSE))
      }
      out <- get_smiles_pubchem(name = name, other = other, kegg = kegg, hmdb = hmdb)
      if (!is.na(out$SMILES) && out$SMILES != "") {
        assign(key, out, envir = cache_env)
      }
      out
    }
  )

  if (!is.null(cache_file)) {
    dir.create(dirname(cache_file), showWarnings = FALSE, recursive = TRUE)
    try(saveRDS(as.list(cache_env), cache_file), silent = TRUE)
  }

  tibble::tibble(
    query_name = query_tbl$query_name,
    query_other = query_tbl$query_other,
    query_kegg = query_tbl$query_kegg,
    query_hmdb = query_tbl$query_hmdb,
    SMILES = purrr::map_chr(match_list, ~ normalize_chr(.x$SMILES)),
    matched_by = purrr::map_chr(match_list, ~ normalize_chr(.x$matched_by)),
    matched_query = purrr::map_chr(match_list, ~ normalize_chr(.x$matched_query)),
    pubchem_cid = purrr::map_chr(match_list, ~ normalize_chr(.x$pubchem_cid))
  )
}

check_required_cols <- function(dat, required_cols) {
  missing_cols <- setdiff(required_cols, colnames(dat))

  if (length(missing_cols) > 0) {
    stop(
      paste0(
        "The following required columns are missing: ",
        paste(missing_cols, collapse = ", "),
        "\nPlease check the column names."
      ),
      call. = FALSE
    )
  }
}

clean_text <- function(x) {
  x <- as.character(x)
  x <- stringr::str_trim(x)
  x[x %in% c("", "NA", "N/A", "NULL", "--", "na", "null")] <- NA_character_
  x
}

normalize_chr <- function(x) {
  if (is.null(x) || length(x) == 0 || all(is.na(x))) {
    return(NA_character_)
  }
  as.character(x[[1]])
}


reft_pubchem_is_bad_text <- function(txt) {
  if (is.null(txt) || length(txt) == 0 || all(is.na(txt))) return(TRUE)
  txt1 <- paste(txt, collapse = "\n")
  if (is.na(txt1) || txt1 == "") return(TRUE)
  grepl(
    paste(c(
      "Service not available",
      "PUGREST.ServerBusy",
      "PUGREST.Timeout",
      "temporarily unavailable",
      "server error",
      "502 Bad Gateway",
      "503 Service Unavailable",
      "504 Gateway Timeout"
    ), collapse = "|"),
    txt1,
    ignore.case = TRUE
  )
}

reft_pubchem_read_text <- function(url,
                                   max_tries = getOption("REFT.pubchem_max_tries", 4),
                                   sleep_sec = getOption("REFT.pubchem_sleep_sec", 0.7),
                                   timeout_sec = getOption("REFT.pubchem_timeout", 30),
                                   verbose = getOption("REFT.pubchem_verbose", FALSE)) {
  old_timeout <- getOption("timeout")
  on.exit(options(timeout = old_timeout), add = TRUE)
  options(timeout = max(old_timeout, timeout_sec))

  last_msg <- NULL
  for (i in seq_len(max_tries)) {
    if (i > 1 || sleep_sec > 0) {
      Sys.sleep(sleep_sec * (2^(i - 1)))
    }

    txt <- tryCatch(
      readLines(url, warn = FALSE, encoding = "UTF-8"),
      error = function(e) {
        last_msg <<- e$message
        NA_character_
      }
    )

    if (!reft_pubchem_is_bad_text(txt)) {
      return(paste(txt, collapse = "\n"))
    }
  }

  if (isTRUE(verbose) && !is.null(last_msg)) {
    message("PubChem request failed after ", max_tries, " tries: ", last_msg)
  }
  NA_character_
}

safe_get_cid <- function(query) {
  if (is.null(query) || length(query) == 0 || is.na(query) || query == "") {
    return(NA_character_)
  }

  query <- stringr::str_squish(as.character(query[[1]]))
  if (is.na(query) || query == "") return(NA_character_)

  # Primary route: direct PubChem PUG-REST call. This avoids version-dependent
  # changes in webchem::get_cid() and gives us explicit retry control.
  url <- paste0(
    "https://pubchem.ncbi.nlm.nih.gov/rest/pug/compound/name/",
    utils::URLencode(query, reserved = TRUE),
    "/cids/TXT"
  )

  txt <- reft_pubchem_read_text(url)
  if (!is.na(txt) && txt != "") {
    ids <- stringr::str_extract_all(txt, "\\d+")[[1]]
    if (length(ids) > 0 && !is.na(ids[1]) && ids[1] != "") {
      return(as.character(ids[1]))
    }
  }

  # Fallback route: keep compatibility with earlier REFT behavior.
  out <- tryCatch({
    x <- tryCatch(
      webchem::get_cid(query, from = "name", match = "first"),
      error = function(e) suppressWarnings(webchem::get_cid(query, from = "name", first = TRUE))
    )
    if (is.null(x)) return(NA_character_)
    x <- as.data.frame(x, stringsAsFactors = FALSE)
    if (nrow(x) == 0 || !("cid" %in% colnames(x))) return(NA_character_)
    as.character(x$cid[1])
  }, error = function(e) {
    NA_character_
  })

  if (length(out) == 0 || is.na(out) || out == "") NA_character_ else out
}

safe_get_smiles_from_cid <- function(cid) {
  if (is.null(cid) || length(cid) == 0 || is.na(cid) || cid == "") {
    return(NA_character_)
  }

  cid <- as.character(cid[[1]])
  url <- paste0(
    "https://pubchem.ncbi.nlm.nih.gov/rest/pug/compound/cid/",
    utils::URLencode(cid, reserved = TRUE),
    "/property/CanonicalSMILES/TXT"
  )

  txt <- reft_pubchem_read_text(url)
  if (!is.na(txt) && txt != "") {
    lines <- stringr::str_split(txt, "\\n", simplify = FALSE)[[1]]
    lines <- stringr::str_trim(lines)
    lines <- lines[lines != ""]
    bad <- stringr::str_detect(lines, "^(CID|Status|Fault|Code|Message|PUGREST|Service)")
    lines <- lines[!bad]
    if (length(lines) > 0 && !is.na(lines[1]) && lines[1] != "") {
      return(as.character(lines[1]))
    }
  }

  # Fallback route: keep compatibility with earlier REFT behavior.
  out <- tryCatch({
    prop <- webchem::pc_prop(cid, properties = "CanonicalSMILES")
    if (is.null(prop) || nrow(prop) == 0) return(NA_character_)
    prop <- as.data.frame(prop, stringsAsFactors = FALSE)
    cn <- colnames(prop)
    smi_col <- cn[grepl("ConnectivitySMILES", cn, ignore.case = TRUE)][1]
    if (is.na(smi_col) || length(smi_col) == 0) {
      smi_col <- cn[grepl("SMILES", cn, ignore.case = TRUE)][1]
    }
    if (is.na(smi_col) || length(smi_col) == 0) return(NA_character_)
    smi <- as.character(prop[[smi_col]][1])
    if (length(smi) == 0 || is.na(smi) || smi == "") return(NA_character_)
    smi
  }, error = function(e) {
    NA_character_
  })

  if (length(out) == 0 || is.na(out) || out == "") NA_character_ else out
}

get_smiles_pubchem <- function(name = NA, other = NA, kegg = NA, hmdb = NA) {
  cid1 <- safe_get_cid(name)
  smi1 <- safe_get_smiles_from_cid(cid1)
  if (!is.na(smi1) && smi1 != "") {
    return(list(
      SMILES = smi1,
      matched_by = "Name",
      matched_query = name,
      pubchem_cid = cid1
    ))
  }

  cid2 <- safe_get_cid(other)
  smi2 <- safe_get_smiles_from_cid(cid2)
  if (!is.na(smi2) && smi2 != "") {
    return(list(
      SMILES = smi2,
      matched_by = "Other_name(Kegg_name)",
      matched_query = other,
      pubchem_cid = cid2
    ))
  }

  cid3 <- safe_get_cid(kegg)
  smi3 <- safe_get_smiles_from_cid(cid3)
  if (!is.na(smi3) && smi3 != "") {
    return(list(
      SMILES = smi3,
      matched_by = "Kegg_ID",
      matched_query = kegg,
      pubchem_cid = cid3
    ))
  }

  cid4 <- safe_get_cid(hmdb)
  smi4 <- safe_get_smiles_from_cid(cid4)
  if (!is.na(smi4) && smi4 != "") {
    return(list(
      SMILES = smi4,
      matched_by = "HMDB_ID",
      matched_query = hmdb,
      pubchem_cid = cid4
    ))
  }

  list(
    SMILES = NA_character_,
    matched_by = NA_character_,
    matched_query = NA_character_,
    pubchem_cid = NA_character_
  )
}

parse_smiles_safe <- function(smi) {
  tryCatch({
    if (is.null(smi) || length(smi) == 0 || is.na(smi) || smi == "") {
      return(NULL)
    }
    mol <- rcdk::parse.smiles(smi)[[1]]
    rcdk::do.aromaticity(mol)
    rcdk::convert.implicit.to.explicit(mol)
    mol
  }, error = function(e) {
    message("parse.smiles error: ", e$message)
    NULL
  })
}

is_missing_mol <- function(mol) {
  is.null(mol) || (is.atomic(mol) && length(mol) == 1 && is.na(mol))
}

empty_desc6 <- function() {
  tibble::tibble(
    MW = NA_real_,
    nHBAcc = NA_real_,
    ALogP = NA_real_,
    FMF = NA_real_,
    HybRatio = NA_real_,
    nAcid = NA_real_
  )
}

calc_desc6 <- function(mol) {
  tryCatch({
    if (is_missing_mol(mol)) {
      return(empty_desc6())
    }

    desc <- rcdk::eval.desc(
      molecules = list(mol),
      which.desc = c(
        "org.openscience.cdk.qsar.descriptors.molecular.WeightDescriptor",
        "org.openscience.cdk.qsar.descriptors.molecular.HBondAcceptorCountDescriptor",
        "org.openscience.cdk.qsar.descriptors.molecular.ALOGPDescriptor",
        "org.openscience.cdk.qsar.descriptors.molecular.FMFDescriptor",
        "org.openscience.cdk.qsar.descriptors.molecular.HybridizationRatioDescriptor",
        "org.openscience.cdk.qsar.descriptors.molecular.AcidicGroupCountDescriptor"
      ),
      verbose = FALSE
    )

    desc <- as.data.frame(desc, stringsAsFactors = FALSE)

    tibble::tibble(
      MW = if ("MW" %in% colnames(desc)) as.numeric(desc$MW[1]) else NA_real_,
      nHBAcc = if ("nHBAcc" %in% colnames(desc)) as.numeric(desc$nHBAcc[1]) else NA_real_,
      ALogP = if ("ALogP" %in% colnames(desc)) as.numeric(desc$ALogP[1]) else NA_real_,
      FMF = if ("FMF" %in% colnames(desc)) as.numeric(desc$FMF[1]) else NA_real_,
      HybRatio = if ("HybRatio" %in% colnames(desc)) as.numeric(desc$HybRatio[1]) else NA_real_,
      nAcid = if ("nAcid" %in% colnames(desc)) as.numeric(desc$nAcid[1]) else NA_real_
    )
  }, error = function(e) {
    message("calc_desc6 error: ", e$message)
    empty_desc6()
  })
}
