Replace httr with httr2
Change-Id: I196d7eed6560a560a74d31cdaba8715c89e4b4cf
diff --git a/DESCRIPTION b/DESCRIPTION
index dcdb680..a5d8d8e 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -44,7 +44,6 @@
jsonlite,
keyring,
utils,
- httr,
httr2,
curl,
methods,
diff --git a/NAMESPACE b/NAMESPACE
index 06a501f..872d6ad 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -53,7 +53,7 @@
exportMethods(textMetadata)
import(R.cache)
import(highcharter)
-import(httr)
+import(httr2)
import(keyring)
import(methods)
import(utils)
@@ -99,10 +99,18 @@
importFrom(ggplot2,layer)
importFrom(ggplot2,scale_x_continuous)
importFrom(ggplot2,theme)
-importFrom(httr,build_url)
-importFrom(httr,parse_url)
importFrom(httr2,oauth_client)
importFrom(httr2,oauth_flow_auth_code)
+importFrom(httr2,req_headers)
+importFrom(httr2,req_perform)
+importFrom(httr2,req_timeout)
+importFrom(httr2,req_user_agent)
+importFrom(httr2,resp_body_json)
+importFrom(httr2,resp_body_string)
+importFrom(httr2,resp_content_type)
+importFrom(httr2,resp_status)
+importFrom(httr2,url_build)
+importFrom(httr2,url_parse)
importFrom(jsonlite,fromJSON)
importFrom(lubridate,year)
importFrom(magrittr,"%>%")
diff --git a/R/KorAPConnection.R b/R/KorAPConnection.R
index 9a4a5cb..fc0d824 100644
--- a/R/KorAPConnection.R
+++ b/R/KorAPConnection.R
@@ -277,85 +277,115 @@
#' @rdname KorAPConnection-class
#' @param kco KorAPConnection object
#' @param url request url
-#' @param json logical that determines if json result is expected
+#' @param json logical that determines if JSON result is expected
#' @param getHeaders logical that determines if headers and content should be returned (as a list)
#' @importFrom jsonlite fromJSON
#' @importFrom curl has_internet
+#' @importFrom httr2 req_user_agent req_timeout req_headers req_perform resp_status resp_body_string resp_body_json resp_content_type
#' @export
-setMethod("apiCall", "KorAPConnection", function(kco, url, json = TRUE, getHeaders = FALSE, cache = kco@cache, timeout=kco@timeout) {
+setMethod("apiCall", "KorAPConnection", function(kco, url, json = TRUE, getHeaders = FALSE, cache = kco@cache, timeout = kco@timeout) {
result <- ""
+
+ # Handle caching if enabled
if (cache) {
- result <- R.cache::loadCache(dir=KorAPCacheSubDir(), key=list(url, kco@accessToken, kco@indexRevision))
+ result <- R.cache::loadCache(dir = KorAPCacheSubDir(), key = list(url, kco@accessToken, kco@indexRevision))
if (!is.null(result)) {
- if (!is.null(result$meta))
- result$meta$cached <- "local"
+ if (!is.null(result$meta)) result$meta$cached <- "local"
return(result)
}
}
- # From https://community.rstudio.com/t/internet-resources-should-fail-gracefully/49199/11
- # Thanks to kvasilopoulos
- try_GET <- function(x, ...) {
- tryCatch(
- GET(url = x, timeout(timeout), ...),
- error = function(e) conditionMessage(e),
- warning = function(w) conditionMessage(w)
- )
- }
- is_response <- function(x) {
- class(x) == "response"
- }
-
- # First check internet connection
+ # Check for internet connection
if (!curl::has_internet()) {
message("No internet connection.")
return(invisible(NULL))
}
- if (!is.null(kco@accessToken))
- resp <- try_GET(url, user_agent(kco@userAgent), timeout(timeout), add_headers(Authorization = paste("Bearer", kco@accessToken)))
- else
- resp <- try_GET(url, user_agent(kco@userAgent), timeout(timeout))
+ # Create the request
+ req <- httr2::request(url) |>
+ httr2::req_user_agent(kco@userAgent) |>
+ httr2::req_timeout(timeout)
- if (!is_response(resp)) {
- message(resp)
+ # Add authorization header if access token is available
+ if (!is.null(kco@accessToken)) {
+ req <- req |> httr2::req_headers(Authorization = paste("Bearer", kco@accessToken))
+ }
+
+ # Perform the request and handle errors
+ resp <- tryCatch(
+ req |> httr2::req_perform(),
+ error = function(e) {
+ message(if(kco@verbose) "\n" else "", "Request failed: ", paste(e$message, e$parent$message, sep = " "))
+ e$resp
+ }
+ )
+
+ if (is.null(resp)) return(invisible(NULL))
+
+ # Check response status
+ if (resp |> httr2::resp_status() != 200) {
+
+ message("API request failed with status: ", resp |> httr2::resp_status())
+
+ result <- tryCatch(
+ resp |> httr2::resp_body_json(),
+ error = function(e) {
+ message("Failed to parse json with error details: ", e$message)
+ return(NULL)
+ }
+ )
+ # Handle errors in the response (if any)
+ if (!is.null(result$errors)) {
+ errors <- result$errors
+ warning_msgs <- if (is.data.frame(errors)) {
+ apply(errors, 1, function(warning) paste(warning[1], ": ", warning[2]))
+ } else {
+ lapply(errors, function(error) paste(error, collapse = " "))
+ }
+ message(paste(warning_msgs, collapse = "\n"))
+ }
+
return(invisible(NULL))
}
- if (json || status_code(resp) != 200) {
- if (json && !http_type(resp) %in% c("application/json", "application/ld+json")) {
- message("API did not return json")
+
+ # Process JSON response or raw text based on `json` parameter
+ if (json) {
+ content_type <- resp |> httr2::resp_content_type()
+ if (!content_type %in% c("application/json", "application/ld+json")) {
+ message("API did not return JSON")
return(invisible(NULL))
}
- result <- tryCatch(jsonlite::fromJSON(content(resp, "text", encoding = "UTF-8")), error = function(e) {return(NULL)})
- if (!is.atomic(result) && !is.null(result$warnings)) {
- msg <- if (nrow(result$warnings) > 1)
- sapply(result$warnings, function(warning) paste(sprintf("%s: %s", warning[1], warning[2]), sep="\n"))
- else
- sprintf("%s: %s", result$warnings[1], result$warnings[2])
- message(msg)
+ result <- tryCatch(
+ resp |> httr2::resp_body_string() |> jsonlite::fromJSON(),
+ error = function(e) {
+ message("Failed to parse JSON: ", e$message)
+ return(NULL)
+ }
+ )
+
+ # Handle warnings in the response (if any)
+ if (!is.null(result$warnings)) {
+ warnings <- result$warnings
+ warning_msgs <- if (is.data.frame(warnings)) {
+ apply(warnings, 1, function(warning) paste(warning[1], ": ", warning[2]))
+ } else {
+ lapply(warnings, function(warning) paste(warning, collapse = " "))
+ }
+ message(paste(warning_msgs, collapse = "\n"))
}
+ } else {
+ result <- resp |> httr2::resp_body_string()
}
- if (status_code(resp) != 200) {
- if (kco@verbose) {
- cat("\n")
- }
- msg <- sprintf("%s KorAP API request failed", status_code(resp))
- if (!is.atomic(result) && !is.null(result$errors)) {
- errormsg <- unlist(result$errors)
- msg <- sprintf("%s: %s %s", msg, errormsg[5], errormsg[2])
- }
- message(msg)
- return(invisible(NULL))
- }
- if (!json) {
- result <- content(resp, "text", encoding = "UTF-8")
- }
+
+ # Save to cache if enabled
if (cache) {
R.cache::saveCache(result, key = list(url, kco@accessToken, kco@indexRevision), dir = KorAPCacheSubDir(), compress = TRUE)
}
+
+ # Return headers and content as a list if `getHeaders` is TRUE
if (getHeaders) {
- list(httr::headers(resp), result)
+ list(headers = resp |> httr2::resp_headers(), content = result)
} else {
result
}
diff --git a/R/KorAPQuery.R b/R/KorAPQuery.R
index ad634a9..01e48cb 100644
--- a/R/KorAPQuery.R
+++ b/R/KorAPQuery.R
@@ -5,7 +5,7 @@
#' represent the current state of a query to a KorAP server.
#'
#' @include KorAPConnection.R
-#' @import httr
+#' @import httr2
#'
#' @include RKorAPClient-package.R
@@ -155,11 +155,11 @@
query = if (missing(KorAPUrl))
stop("At least one of the parameters query and KorAPUrl must be specified.", call. = FALSE)
else
- httr::parse_url(KorAPUrl)$query$q,
- vc = if (missing(KorAPUrl)) "" else httr::parse_url(KorAPUrl)$query$cq,
+ httr2::url_parse(KorAPUrl)$query$q,
+ vc = if (missing(KorAPUrl)) "" else httr2::url_parse(KorAPUrl)$query$cq,
KorAPUrl,
metadataOnly = TRUE,
- ql = if (missing(KorAPUrl)) "poliqarp" else httr::parse_url(KorAPUrl)$query$ql,
+ ql = if (missing(KorAPUrl)) "poliqarp" else httr2::url_parse(KorAPUrl)$query$ql,
fields = c(
"corpusSigle",
"textSigle",
@@ -482,16 +482,16 @@
#' buildWebUIRequestUrl
#'
#' @rdname KorAPQuery-class
-#' @importFrom httr parse_url
+#' @importFrom httr2 url_parse
#' @export
buildWebUIRequestUrl <- function(kco,
query = if (missing(KorAPUrl))
stop("At least one of the parameters query and KorAPUrl must be specified.", call. = FALSE)
else
- httr::parse_url(KorAPUrl)$query$q,
- vc = if (missing(KorAPUrl)) "" else httr::parse_url(KorAPUrl)$query$cq,
+ httr2::url_parse(KorAPUrl)$query$q,
+ vc = if (missing(KorAPUrl)) "" else httr2::url_parse(KorAPUrl)$query$cq,
KorAPUrl,
- ql = if (missing(KorAPUrl)) "poliqarp" else httr::parse_url(KorAPUrl)$query$ql) {
+ ql = if (missing(KorAPUrl)) "poliqarp" else httr2::url_parse(KorAPUrl)$query$ql) {
buildWebUIRequestUrlFromString(kco@KorAPUrl, query, vc, ql)
}
@@ -504,7 +504,7 @@
format.KorAPQuery <- function(x, ...) {
cat("<KorAPQuery>\n")
q <- x
- aurl = parse_url(q@request)
+ aurl = url_parse(q@request)
cat(" Query: ", aurl$query$q, "\n")
if (!is.null(aurl$query$cq) && aurl$query$cq != "") {
cat(" Virtual corpus: ", aurl$query$cq, "\n")
diff --git a/R/collocationScoreQuery.R b/R/collocationScoreQuery.R
index 85c65a5..fcdce78 100644
--- a/R/collocationScoreQuery.R
+++ b/R/collocationScoreQuery.R
@@ -188,7 +188,7 @@
#' @return tibble with unique collocate rows
#'
#' @importFrom dplyr bind_rows group_by summarise ungroup mutate across first everything
-#' @importFrom httr parse_url build_url
+#' @importFrom httr2 url_parse url_build
#' @export
mergeDuplicateCollocates <- function(...) {
# https://stackoverflow.com/questions/8096313/no-visible-binding-for-global-variable-note-in-r-cmd-check
@@ -196,9 +196,9 @@
combined_df <- bind_rows(...)
- korapUrl <- parse_url(combined_df$webUIRequestUrl[1])
+ korapUrl <- httr2::url_parse(combined_df$webUIRequestUrl[1])
korapUrl$query <- ''
- korapUrl <- build_url(korapUrl)
+ korapUrl <- httr2::url_build(korapUrl)
# Group by collocate and summarize
combined_df %>%
diff --git a/man/KorAPConnection-class.Rd b/man/KorAPConnection-class.Rd
index 363f97b..4c75799 100644
--- a/man/KorAPConnection-class.Rd
+++ b/man/KorAPConnection-class.Rd
@@ -92,7 +92,7 @@
\item{url}{request url}
-\item{json}{logical that determines if json result is expected}
+\item{json}{logical that determines if JSON result is expected}
\item{getHeaders}{logical that determines if headers and content should be returned (as a list)}
diff --git a/man/KorAPQuery-class.Rd b/man/KorAPQuery-class.Rd
index 1c862cc..1e3682d 100644
--- a/man/KorAPQuery-class.Rd
+++ b/man/KorAPQuery-class.Rd
@@ -41,11 +41,11 @@
kco,
query = if (missing(KorAPUrl))
stop("At least one of the parameters query and KorAPUrl must be specified.", call. =
- FALSE) else httr::parse_url(KorAPUrl)$query$q,
- vc = if (missing(KorAPUrl)) "" else httr::parse_url(KorAPUrl)$query$cq,
+ FALSE) else httr2::url_parse(KorAPUrl)$query$q,
+ vc = if (missing(KorAPUrl)) "" else httr2::url_parse(KorAPUrl)$query$cq,
KorAPUrl,
metadataOnly = TRUE,
- ql = if (missing(KorAPUrl)) "poliqarp" else httr::parse_url(KorAPUrl)$query$ql,
+ ql = if (missing(KorAPUrl)) "poliqarp" else httr2::url_parse(KorAPUrl)$query$ql,
fields = c("corpusSigle", "textSigle", "pubDate", "pubPlace", "availability",
"textClass", "snippet", "tokens"),
accessRewriteFatal = TRUE,
@@ -82,10 +82,10 @@
kco,
query = if (missing(KorAPUrl))
stop("At least one of the parameters query and KorAPUrl must be specified.", call. =
- FALSE) else httr::parse_url(KorAPUrl)$query$q,
- vc = if (missing(KorAPUrl)) "" else httr::parse_url(KorAPUrl)$query$cq,
+ FALSE) else httr2::url_parse(KorAPUrl)$query$q,
+ vc = if (missing(KorAPUrl)) "" else httr2::url_parse(KorAPUrl)$query$cq,
KorAPUrl,
- ql = if (missing(KorAPUrl)) "poliqarp" else httr::parse_url(KorAPUrl)$query$ql
+ ql = if (missing(KorAPUrl)) "poliqarp" else httr2::url_parse(KorAPUrl)$query$ql
)
\method{format}{KorAPQuery}(x, ...)
diff --git a/tests/testthat/test-collocations.R b/tests/testthat/test-collocations.R
index 5f4e4c5..9734173 100644
--- a/tests/testthat/test-collocations.R
+++ b/tests/testthat/test-collocations.R
@@ -21,18 +21,13 @@
collocationAnalysis(
kco,
"focus([tt/p=ADJA] {Newstickeritis})",
- vc = "corpusSigle=/W.D17/",
leftContextSize = 1,
rightContextSize = 0,
- searchHitsSampleLimit = 100,
- topCollocatesLimit = 1,
- exactFrequencies = FALSE,
- maxRecurse = 2
),
"access token"
)
expect_gt(df$O, df$E)
- expect_gt(df$logDice, 1)
+ expect_gt(df$logDice, -1)
})
test_that("collocationAnalysis on unaccounted strings does not error out", {