fix: new search phmmer

R/api.R

@@ -0,0 +1,50 @@
+hmmer_request <- function(
+    algo, ..., seq = NULL, hmmdb = NULL, seqdb = NULL, max_tries = 5) {
+  if (length(c(seqdb, hmmdb)) != 1) {
+    stop("You must specify either a seqdb or a hmmdb, not both.")
+  }
+  body <- list(
+    ...,
+    seq = seq,
+    hmmdb = hmmdb,
+    seqdb = seqdb
+  ) |>
+    purrr::compact()
+
+  user_agent_string <- "HMMERutils (https://github.com/currocam/HMMERutils)"
+  httr2::request("https://www.ebi.ac.uk/Tools/hmmer/search") |>
+    httr2::req_user_agent(user_agent_string) |>
+    httr2::req_headers("Accept" = "application/json") |>
+    httr2::req_url_path_append(algo) |>
+    httr2::req_retry(max_tries = max_tries) |>
+    httr2::req_body_json(body)
+}
+
+resp_get_uuid <- function(req) {
+  purrr::chuck(req, "url") |>
+    stringr::str_split("/") |>
+    purrr::chuck(1, 7)
+}
+
+req_perform_custom <- function(r) {
+  response <- httr2::req_perform(r, path = tempfile())
+  Sys.sleep(15)
+  response
+}
+
+
+multi_req_perform_custom <- function(requests) {
+  f <- purrr::possibly(req_perform_custom, otherwise = NULL, quiet = FALSE)
+  responses <- purrr::map(requests, f)
+  names(responses) <- purrr::map(responses, "url") |> as.character()
+  responses
+}
+
+add_fullfasta <- function(data, uuid) {
+  fasta <- uuid |>
+    create_download_url_for_hmmer("fullfasta") |>
+    download_file() |>
+    Biostrings::readAAStringSet()
+  tibble::tibble(hits.name = names(fasta), hits.fullfasta = as.character(fasta)) |>
+    dplyr::full_join(data, by = "hits.name")
+}

R/search_phmmer.R

@@ -10,36 +10,43 @@
 #' `pdb` and `alphafold`, but a complete and updated list is available at
 #' \url{https://www.ebi.ac.uk/Tools/hmmer/}.
 #' @param verbose A logical, if TRUE details of the download process is printed.
-#' @param timeout Set maximum request time in seconds.
+#' @param max_tries Cap the maximum number of attempts with max_tries.
 #'
 #' @return An Data Frame containing the results from HMMER.
 #'
 #' @examples
 #' search_phmmer(
-#'     seq = "MTEITAAMVKELRTGAGMMDCKN",
-#'     seqdb = "pdb",
-#'     verbose = FALSE
+#'   seq = "MTEITAAMVKELRTGAGMMDCKN",
+#'   seqdb = "pdb",
+#'   verbose = FALSE
 #' )
 #' @export
+search_phmmer <- function(seq, seqdb, max_tries = 5, verbose = TRUE) {
+  requests <- purrr::map2(
+    seq, seqdb,
+    ~ hmmer_request(
+      algo = "phmmer", seq = convert_input_seq(.x), seqdb = .y
+    )
+  )
+  if (verbose) {
+    requests <- purrr::map(requests, httr2::req_verbose)
+  }
 
-search_phmmer <- function(seq, seqdb = "swissprot", timeout = 180, verbose = FALSE) { # nolint
-    httr::reset_config()
-    if (verbose) {
-        httr::set_config(httr::verbose())
+  responses <- multi_req_perform_custom(requests)
+
+  purrr::pmap(
+    list(responses, seq, seqdb),
+    ~ {
+      data <- ..1 |>
+        httr2::resp_body_json(simplifyVector = TRUE) |>
+        purrr::chuck("results", "hits") |>
+        tibble::as_tibble()
+      colnames(data) <- paste0("hits.", colnames(data))
+
+      data |>
+        dplyr::mutate(sequence_header = names(..2), database = ..3) |>
+        add_fullfasta(uuid = resp_get_uuid(..1))
     }
-    phmmer <- purrr::possibly(search_in_hmmer, otherwise = NULL) # nolint
-    seq <- convert_input_seq(seq)
-    # all combinations of inputs
-    tidyr::expand_grid(seq, seqdb, algorithm = "phmmer") %>%
-        dplyr::rowwise() %>%
-        purrr::pmap(
-            ~ phmmer(
-                seq = ..1,
-                seqdb = ..2,
-                algorithm = ..3,
-                timeout_in_seconds = timeout
-            )
-        ) %>%
-        purrr::compact() %>%
-        dplyr::bind_rows()
+  ) |>
+    dplyr::bind_rows(.id = "temporary_url")
 }

tests/testthat/_snaps/api.md

@@ -0,0 +1,19 @@
+# base request works
+
+    Code
+      hmmer_request(algo = "phmmer", seq = "AAACATT", seqdb = "swissprot")
+    Message <cliMessage>
+      <httr2_request>
+      POST https://www.ebi.ac.uk/Tools/hmmer/search/phmmer
+      Headers:
+      * Accept: 'application/json'
+      Body: json encoded data
+      Options:
+      * useragent: 'HMMERutils (http://github.com/currocam/HMMERutils/)'
+      Policies:
+      * retry_max_tries: 5
+
+# base request fails when both seqdb and hmmdb
+
+    You must specify either a seqdb or a hmmdb, not both.
+

tests/testthat/test-api.R

@@ -0,0 +1,9 @@
+test_that("base request works", {
+  hmmer_request(algo = "phmmer", seq = "AAACATT", seqdb = "swissprot") |>
+    testthat::expect_snapshot()
+})
+
+test_that("base request fails when both seqdb and hmmdb", {
+  hmmer_request(algo = "phmmer", seq = "AAACATT",hmmdb = "pfam", seqdb = "swissprot") |>
+    testthat::expect_snapshot_error()
+})