Address #16, #18

.Rbuildignore

@@ -17,3 +17,4 @@ inst/*.png
 paper/
 ^LICENSE\.md$
 ^codemeta\.json$
+^.github$

R/fetch.R

@@ -28,6 +28,7 @@
 #' @param use_probeMap if `TRUE`, will check if the dataset has ProbeMap firstly.
 #' When the dataset you want to query has a identifier-to-gene mapping, identifiers can be
 #' gene symbols even the identifiers of dataset are probes or others.
+#' @param time_limit time limit for getting response in seconds.
 #' @return a `matirx` or character vector.
 #' @examples
 #' library(UCSCXenaTools)
@@ -56,7 +57,8 @@ fetch <- function(host, dataset) {
 
 #' @describeIn fetch fetches values from a dense matrix.
 #' @export
-fetch_dense_values <- function(host, dataset, identifiers = NULL, samples = NULL, check = TRUE, use_probeMap = FALSE) {
+fetch_dense_values <- function(host, dataset, identifiers = NULL, samples = NULL,
+                               check = TRUE, use_probeMap = FALSE, time_limit = 30) {
   stopifnot(
     length(host) == 1, length(dataset) == 1,
     is.character(host), is.character(dataset),
@@ -127,7 +129,32 @@ fetch_dense_values <- function(host, dataset, identifiers = NULL, samples = NULL
     message("-> Checking if the dataset has probeMap...")
     if (has_probeMap(host, dataset)) {
       message("-> Done. ProbeMap is found.")
-      res <- .p_dataset_gene_probe_avg(host, dataset, samples, identifiers)
+
+      t_start = Sys.time()
+      while (as.numeric(Sys.time() - t_start) < time_limit) {
+        res <- tryCatch(
+          {
+            .p_dataset_gene_probe_avg(host, dataset, samples, identifiers)
+          },
+          error = function(e) {
+            message("-> Query faild. Retrying...")
+            list(has_error = TRUE, error_info = e)
+          }
+        )
+        if (is.data.frame(res)) {
+          break()
+        }
+        Sys.sleep(1)
+      }
+
+      if (!is.data.frame(res)) {
+        stop(paste(
+          "The response times out and still returns an error",
+          res$error_info$message,
+          sep = "\n"
+        ))
+      }
+
       res <- t(sapply(res[["scores"]], base::rbind))
       rownames(res) <- identifiers
       colnames(res) <- samples
@@ -136,7 +163,31 @@ fetch_dense_values <- function(host, dataset, identifiers = NULL, samples = NULL
     message("-> Done. No probeMap found, use old way...")
   }
 
-  res <- .p_dataset_fetch(host, dataset, samples, identifiers)
+  t_start = Sys.time()
+  while (as.numeric(Sys.time() - t_start) < time_limit) {
+    res <- tryCatch(
+      {
+        .p_dataset_fetch(host, dataset, samples, identifiers)
+      },
+      error = function(e) {
+        message("-> Query faild. Retrying...")
+        list(has_error = TRUE, error_info = e)
+      }
+    )
+    if (is.atomic(res)) {
+      break()
+    }
+    Sys.sleep(1)
+  }
+
+  if (!is.atomic(res)) {
+    stop(paste(
+      "The response times out and still returns an error",
+      res$error_info$message,
+      sep = "\n"
+    ))
+  }
+
   rownames(res) <- identifiers
   colnames(res) <- samples
   res

tests/testthat/test-full-tests.R

@@ -70,24 +70,92 @@ fetch()
 # Fetch samples
 fetch_dataset_samples(host, dataset, 2)
 # Fetch identifiers
+tryCatch({
+  fetch_dataset_identifiers(host, dataset)
+}, error = function(e) {
+  if (grepl("500", e$message)) {
+    message("Bad network, skipping check")
+  } else {
+    stop(e$message)
+  }
+})
 
-fetch_dataset_identifiers(host, dataset)
 
 # Fetch expression value by probes
-fetch_dense_values(host, dataset, probes, samples, check = FALSE)
-fetch_dense_values(host, dataset, probes, samples[1], check = TRUE)
-fetch_dense_values(host, dataset, probes[1], samples[1], check = TRUE)
-expect_error(fetch_dense_values(host, dataset, 33, samples[1], check = TRUE))
-expect_error(fetch_dense_values(host, dataset, probes[1], 33, check = TRUE))
-fetch_dense_values(host, dataset, c(probes[1], "xxx"), c(samples[1], "xxx"), check = TRUE)
+tryCatch({
+  fetch_dense_values(host, dataset, probes, samples, check = FALSE)
+}, error = function(e) {
+  if (grepl("500", e$message)) {
+    message("Bad network, skipping check")
+  } else {
+    stop(e$message)
+  }
+})
+
+tryCatch({
+  fetch_dense_values(host, dataset, probes, samples[1], check = TRUE)
+}, error = function(e) {
+  if (grepl("500", e$message)) {
+    message("Bad network, skipping check")
+  } else {
+    stop(e$message)
+  }
+})
+
+tryCatch({
+  fetch_dense_values(host, dataset, probes[1], samples[1], check = TRUE)
+}, error = function(e) {
+  if (grepl("500", e$message)) {
+    message("Bad network, skipping check")
+  } else {
+    stop(e$message)
+  }
+})
+
+tryCatch({
+  fetch_dense_values(host, dataset, probes[1], samples[1], check = TRUE)
+}, error = function(e) {
+  if (grepl("500", e$message)) {
+    message("Bad network, skipping check")
+  } else {
+    stop(e$message)
+  }
+})
+
+tryCatch({
+  expect_error(fetch_dense_values(host, dataset, probes[1], 33, check = TRUE))
+}, error = function(e) {
+  if (grepl("500", e$message)) {
+    message("Bad network, skipping check")
+  } else {
+    stop(e$message)
+  }
+})
+
+tryCatch({
+  fetch_dense_values(host, dataset, c(probes[1], "xxx"), c(samples[1], "xxx"), check = TRUE)
+}, error = function(e) {
+  if (grepl("500", e$message)) {
+    message("Bad network, skipping check")
+  } else {
+    stop(e$message)
+  }
+})
 
 # The following two are two time consuming
 # fetch_dense_values(host, dataset, probes[1], check = TRUE)
 # fetch_dense_values(host, dataset, samples = samples[1], check = TRUE)
 
 # Fetch expression value by gene symbol (if the dataset has probeMap)
-fetch_dense_values(host, dataset, genes, samples, check = TRUE, use_probeMap = TRUE)
-
+tryCatch({
+  fetch_dense_values(host, dataset, genes, samples, check = TRUE, use_probeMap = TRUE)
+}, error = function(e) {
+  if (grepl("500", e$message)) {
+    message("Bad network, skipping check")
+  } else {
+    stop(e$message)
+  }
+})
 
 # Workflow ----------------------------------------------------------------
 expect_warning(XenaFilter(xe))