Merge pull request #6 from eea/develop

few improvements

Author: mckeea

DESCRIPTION

@@ -23,7 +23,8 @@ Imports:
   magrittr,
   htmltools,
   stringr,
-  humanize
+  scales,
+  progress
 Depends: 
     R (>= 2.10),
 Suggests: 

R/client.R

@@ -85,7 +85,7 @@ Client <- R6::R6Class("Client",
         error = function(err) {
           resp <- httr2::last_response()
 
-          if (resp$status_code == 403 || resp$status_code == 401) {
+          if (!is.null(resp) && (resp$status_code == 403 || resp$status_code == 401)) {
             private$auth$get_token()
             req <- req %>% httr2::req_headers(Authorization = paste("Bearer", private$auth$token()))
 
@@ -94,13 +94,11 @@ Client <- R6::R6Class("Client",
                 req %>% httr2::req_perform()
               },
               error = function(err) {
-                error_message <- private$extract_error_message(resp)
-                stop(paste("Network Error:", error_message, sep = "\n"))
+                stop(format_error_message(err))
               }
             )
           } else {
-            error_message <- private$extract_error_message(resp)
-            stop(paste("Network Error:", error_message, sep = "\n"))
+            stop(format_error_message(resp))
           }
         }
       )
@@ -263,7 +261,7 @@ Client <- R6::R6Class("Client",
       url <- paste0(self$apiUrl, "/datasets")
       req <- httr2::request(url) %>%
         httr2::req_method("GET") %>%
-        httr2::req_url_query(q = pattern, startIndex = 0, itemsPerPage = 10)
+        httr2::req_url_query(q = pattern, startIndex = 0, itemsPerPage = 100)
 
       tryCatch(
         {
@@ -272,6 +270,7 @@ Client <- R6::R6Class("Client",
           lapply(datasets, private$extract_dataset_meta)
         },
         error = function(err) {
+          print(err)
           stop(paste("Datasets query failed"))
         }
       )
@@ -287,7 +286,7 @@ Client <- R6::R6Class("Client",
     #' @seealso \code{\link[=SearchResults]{SearchResults}} for details on the returned object.
     #' @importFrom httr2 request req_method req_body_json
     #' @importFrom stringr str_detect
-    #' @importFrom humanize natural_size
+    #' @importFrom scales label_bytes
     #' @export
     search = function(json_query, limit = NULL) {
       json_query <- strip_off_template_placeholders(json_query)
@@ -306,13 +305,17 @@ Client <- R6::R6Class("Client",
           search_results <- SearchResults$new(self, results, query$dataset_id)
 
           message(paste("Found", search_results$total_count, "files"))
-          message(paste("Total Size", humanize::natural_size(search_results$total_size)))
+          message(paste("Total Size", scales::label_bytes()(search_results$total_size)))
 
           search_results
         },
         error = function(err) {
-          warning("Search query failed")
-          stop(err)
+          msg <- sprintf(
+            "Failed to search data:\n%s\n\nOriginal error:\n%s",
+            conditionMessage(err),
+            capture.output(str(err))
+          )
+          stop(msg)
         }
       )
     },
@@ -342,7 +345,6 @@ Client <- R6::R6Class("Client",
 
       if (to_json) {
         resp <- jsonlite::toJSON(resp, pretty = TRUE, auto_unbox = TRUE, digits = 17)
-        print(resp)
       }
       resp
     },
@@ -501,18 +503,6 @@ Client <- R6::R6Class("Client",
         "doi" = doi,
         "thumbnails" = meta[["thumbnails"]]
       )
-    },
-    extract_error_message = function(resp) {
-      content_type <- httr2::resp_content_type(resp)
-
-      if (grepl("application/json", content_type)) {
-        resp %>%
-          httr2::resp_body_json() %>%
-          jsonlite::toJSON(pretty = TRUE, auto_unbox = TRUE, digits = 17)
-      } else {
-        # For other content types (e.g., text)
-        resp %>% httr2::resp_body_string()
-      }
     }
   )
 )

R/paginator.R

@@ -36,8 +36,12 @@ Paginator <- R6::R6Class("Paginator",
           results
         },
         error = function(err) {
-          error = paste("Error when getting data with paginator", err, sep = "\n")
-          stop(error)
+          msg <- sprintf(
+            "Failed to retrieve data using paginator:\n%s\n\nOriginal error:\n%s",
+            conditionMessage(err),
+            capture.output(str(err))
+          )
+          stop(msg)
         }
       )
     }
@@ -46,12 +50,13 @@ Paginator <- R6::R6Class("Paginator",
     client = NULL,
     request_type = NULL,
     get_page = function(request, start_index = 0, items_per_page = 10) {
-
       req <- request
       if (private$request_type == "POST") {
         req <- req %>%
-          httr2::req_body_json_modify(startIndex = start_index,
-                                      itemsPerPage = items_per_page)
+          httr2::req_body_json_modify(
+            startIndex = start_index,
+            itemsPerPage = items_per_page
+          )
       } else {
         params <- list(
           startIndex = start_index,

R/search_results.R

@@ -48,45 +48,59 @@ SearchResults <- R6::R6Class("SearchResults",
     #' @param force Optional; forces the download even if the file already exists in the specified output directory.
     #' @param prompt Optional; enables all user prompts for decisions during file downloads. Defaults to true.
     #' @return Nothing returned but downloaded files are saved at the specified location.
+    #' @importFrom progress progress_bar
     #' @export
     download = function(output_dir, selected_indexes, stop_at_failure = TRUE, force = FALSE, prompt = TRUE) {
       if (self$total_count == 0 || (prompt && !private$prompt_user_confirmation(self$total_size))) {
         return(NULL)
       }
 
-      message("[Download] Start")
-
       if (!dir.exists(output_dir)) {
         dir.create(output_dir)
       }
 
       resources_to_download <- if (missing(selected_indexes)) self$results else self$results[selected_indexes]
+
+      proggress_bar <- progress::progress_bar$new(
+        format = "[Download] :current/:total (:percent) :elapsed",
+        total = length(resources_to_download),
+        clear = FALSE,
+        width = 60
+      )
+
       i <- 0
-      should_break <- FALSE
       for (r in resources_to_download) {
-        if (should_break) {
-          break
-        }
-
         i <- i + 1
 
-        message(paste0("[Download] Downloading file ", i, "/", length(resources_to_download)))
-
         tryCatch(
           {
             download_id <- private$get_download_id(r)
             is_ready <- private$ensure_download_is_ready(download_id)
             if (is_ready) {
               private$download_resource(download_id, output_dir, force)
             }
+            proggress_bar$tick()
           },
           error = function(err) {
-            warning("Error during the downloading:", err, sep = "\n")
-            should_break <<- stop_at_failure
+            if (stop_at_failure) {
+              proggress_bar$terminate()
+              stop(conditionMessage(err))
+            } else {
+              err_msg <- conditionMessage(err)
+              message(err_msg)
+
+              # Special handling for HTTP 429
+              if (grepl("\\[HTTP 429\\]", err_msg)) {
+                proggress_bar$terminate()
+                stop(sprintf("Operation halted due to rate limit (HTTP 429). Please slow down your requests."))
+              }
+
+              proggress_bar$message(conditionMessage(err))
+              proggress_bar$tick()
+            }
           }
         )
       }
-      message("[Download] DONE")
     }
   ),
   private = list(
@@ -132,7 +146,7 @@ SearchResults <- R6::R6Class("SearchResults",
 
       # Check if the file already exists and force flag is FALSE
       if (file.exists(file_path) && !force) {
-        warning("File already exists:", file_path, "- Skipping download.\n")
+        # warning("File already exists:", file_path, "- Skipping download.\n")
         return(NA)
       }
 
@@ -141,7 +155,12 @@ SearchResults <- R6::R6Class("SearchResults",
 
       resp <- private$client$send_request(req, TRUE)
       if (resp$status_code != 200) {
-        stop(paste("Couldn't download: ", url))
+        stop(sprintf(
+          "Failed to download data.\nURL: %s\nStatus code: %s\nReason: %s",
+          url,
+          resp$status_code,
+          resp$status_text %||% "Unknown"
+        ))
       }
 
       writeBin(httr2::resp_body_raw(resp), file_path)
@@ -150,7 +169,7 @@ SearchResults <- R6::R6Class("SearchResults",
     prompt_user_confirmation = function(total_size) {
       if (total_size >= private$LARGE_DOWNLOAD_SIZE) {
         repeat {
-          message("The total size is ", humanize::natural_size(total_size), ". Do you want to proceed? (Y/N): ")
+          message("The total size is ", scales::label_bytes()(total_size), ". Do you want to proceed? (Y/N): ")
           answer <- tolower(readLines(n = 1))
           if (answer %in% c("y", "n")) {
             return(answer == "y")
@@ -169,7 +188,12 @@ SearchResults <- R6::R6Class("SearchResults",
 
       resp <- private$client$send_request(req, TRUE)
       if (resp$status_code != 200) {
-        stop(paste("Couldn't download: ", url))
+        stop(sprintf(
+          "Failed to download data.\nURL: %s\nStatus code: %s\nReason: %s",
+          url,
+          resp$status_code,
+          resp$status_text %||% "Unknown"
+        ))
       }
 
       # Extract the file name from the Content-Disposition header

R/utils.R

@@ -124,3 +124,68 @@ strip_off_template_placeholders <- function(template) {
 is_single_string <- function(input) {
   is.character(input) & length(input) == 1
 }
+
+format_error_message <- function(
+    err,
+    context = "Operation failed",
+    include_url = TRUE,
+    fallback_status = "Unknown") {
+
+  if (is.null(err)) {
+    return("Unknown Network Error")
+  }
+
+  if (!is.null(err) && inherits(err, "httr2_response")) {
+    resp <- err
+    parsed <- tryCatch(httr2::resp_body_json(resp), error = function(e) NULL)
+
+    # Try to parse the 'detail' field to extract error's metadata
+    parsed_detail <- NULL
+    if (!is.null(parsed$detail) && is.character(parsed$detail) && grepl("^\\s*\\{", parsed$detail)) {
+      parsed_detail <- tryCatch(jsonlite::fromJSON(parsed$detail), error = function(e) NULL)
+    }
+
+    top_status <- parsed$status_code %||% httr2::resp_status(resp) %||% fallback_status
+    top_title <- parsed$title %||% "Unspecified error"
+    top_url <- parsed$url %||% NULL
+
+    nested_status <- parsed_detail$status_code %||% NULL
+    nested_title <- parsed_detail$title %||% NULL
+    nested_detail_text <- parsed_detail$detail %||% ""
+
+    msg_match <- regmatches(nested_detail_text, regexpr("message='([^']+)'", nested_detail_text))
+    url_match <- regmatches(nested_detail_text, regexpr("url='([^']+)'", nested_detail_text))
+
+    extracted_message <- NA
+    if (length(msg_match) == 1 && grepl("message='[^']+'", msg_match)) {
+      extracted_message <- sub("message='([^']+)'", "\\1", msg_match)
+    }
+
+    extracted_url <- NA
+    if (length(url_match) == 1 && grepl("url='[^']+'", url_match)) {
+      extracted_url <- sub("url='([^']+)'", "\\1", url_match)
+    }
+
+    final_title <- nested_title %||% top_title
+    final_status <- nested_status %||% top_status
+
+    message <- sprintf("%s [HTTP %s]: %s", context, final_status, final_title)
+
+    if (!is.null(extracted_message) && !is.na(extracted_message) && nzchar(extracted_message)) {
+      message <- paste0(message, "\nDetail: ", extracted_message)
+    }
+
+    if (include_url && !is.null(extracted_url) && !is.na(extracted_url) &&nzchar(extracted_url)) {
+      message <- paste0(message, "\nURL: ", extracted_url)
+    }
+
+    return(message)
+  }
+
+
+  # Fallback to base condition message
+  msg <- conditionMessage(err)
+  first_line <- strsplit(msg, "\n")[[1]][1]
+  sprintf("%s: %s", context, first_line)
+}
+

R/zzz.R

@@ -1,7 +1,9 @@
+#' @importFrom utils packageVersion
+NULL
+
 .onAttach <- function(libname, pkgname) {
   # Get the package version
-  #' @importFrom utils packageVersion
-  version <- packageVersion(pkgname)
+  version <- utils::packageVersion(pkgname)
   # Console message for additional information
   packageStartupMessage(paste(pkgname, version, "\n"))
 }