Make sure to always fail gracefully if server not accessible
See CRAN policy:
Packages which use Internet resources should fail gracefully with an informative message
if the resource is not available or has changed (and not give a check warning nor error).
at https://cran.r-project.org/web/packages/policies.html
Change-Id: I0c346c75786b8f5392694337254d6f19f91d7caf
diff --git a/R/KorAPConnection.R b/R/KorAPConnection.R
index e4a1ed2..61e0614 100644
--- a/R/KorAPConnection.R
+++ b/R/KorAPConnection.R
@@ -2,6 +2,7 @@
# Use setClassUnion to define the unholy NULL-data union as a virtual class.
################################################################################
setClassUnion("characterOrNULL", c("character", "NULL"))
+setClassUnion("listOrNULL", c("list", "NULL"))
#' Class KorAPConnection
#'
@@ -12,7 +13,7 @@
#' @import utils
#' @import methods
#' @export
-KorAPConnection <- setClass("KorAPConnection", slots=c(KorAPUrl="character", apiVersion="character", indexRevision="characterOrNULL", apiUrl="character", accessToken="characterOrNULL", userAgent="character", timeout="numeric", verbose="logical", cache="logical"))
+KorAPConnection <- setClass("KorAPConnection", slots=c(KorAPUrl="character", apiVersion="character", indexRevision="characterOrNULL", apiUrl="character", accessToken="characterOrNULL", userAgent="character", timeout="numeric", verbose="logical", cache="logical", welcome="listOrNULL"))
#' @param .Object KorAPConnection object
#' @param KorAPUrl the URL of the KorAP server instance you want to access.
@@ -80,9 +81,11 @@
.Object@timeout = timeout
.Object@verbose = verbose
.Object@cache = cache
- welcome <- apiCall(.Object, .Object@apiUrl, json = FALSE, cache = FALSE, getHeaders = TRUE)
- message(welcome[[2]])
- .Object@indexRevision <- welcome[[1]][["x-index-revision"]]
+ .Object@welcome = apiCall(.Object, .Object@apiUrl, json = FALSE, cache = FALSE, getHeaders = TRUE)
+ if (!is.null(.Object@welcome)) {
+ message(.Object@welcome[[2]])
+ }
+ .Object@indexRevision <- .Object@welcome[[1]][["x-index-revision"]]
.Object
})
@@ -175,8 +178,9 @@
#' @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
#' @export
-setMethod("apiCall", "KorAPConnection", function(kco, url, json = TRUE, getHeaders = FALSE, cache = kco@cache) {
+setMethod("apiCall", "KorAPConnection", function(kco, url, json = TRUE, getHeaders = FALSE, cache = kco@cache, timeout=kco@timeout) {
result <- ""
if (cache) {
result <- R.cache::loadCache(dir=KorAPCacheSubDir(), key=list(url, kco@accessToken, kco@indexRevision))
@@ -186,32 +190,60 @@
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
+ if (!curl::has_internet()) {
+ message("No internet connection.")
+ return(invisible(NULL))
+ }
+
if (!is.null(kco@accessToken))
- resp <- GET(url, user_agent(kco@userAgent), timeout(kco@timeout), add_headers(Authorization = paste("Bearer", kco@accessToken)))
+ resp <- try_GET(url, user_agent(kco@userAgent), timeout(timeout), add_headers(Authorization = paste("Bearer", kco@accessToken)))
else
- resp <- GET(url, user_agent(kco@userAgent), timeout(kco@timeout))
+ resp <- try_GET(url, user_agent(kco@userAgent), timeout(timeout))
+
+ if (!is_response(resp)) {
+ message(resp)
+ return(invisible(NULL))
+ }
if (json || status_code(resp) != 200) {
if (json && !http_type(resp) %in% c("application/json", "application/ld+json")) {
- stop("API did not return json", call. = FALSE)
+ # message("API did not return json")
+ return(invisible(NULL))
}
result <- jsonlite::fromJSON(content(resp, "text", encoding = "UTF-8"))
if (!is.null(result$warnings)) {
- message <- if (nrow(result$warnings) > 1)
+ 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])
- warning(message, call. = FALSE)
+ message(msg)
}
}
if (status_code(resp) != 200) {
if (kco@verbose) {
cat("\n")
}
- message <- sprintf("%s KorAP API request failed", status_code(resp))
+ msg <- sprintf("%s KorAP API request failed", status_code(resp))
if (!is.null(result$errors)) {
- message <- sprintf("%s - %s %s", message, result$errors[1], result$errors[2])
+ errormsg <- unlist(result$errors)
+ msg <- sprintf("%s: %s %s", msg, errormsg[5], errormsg[2])
}
- stop(message, call. = FALSE)
+ message(msg)
+ return(invisible(NULL))
}
if (!json) {
result <- content(resp, "text", encoding = "UTF-8")
diff --git a/R/KorAPCorpusStats.R b/R/KorAPCorpusStats.R
index 7d299ca..68e1103 100644
--- a/R/KorAPCorpusStats.R
+++ b/R/KorAPCorpusStats.R
@@ -47,6 +47,9 @@
URLencode(enc2utf8(vc), reserved = TRUE))
log.info(verbose, "Getting size of virtual corpus \"", vc, "\"", sep = "")
res <- apiCall(kco, url)
+ if(is.null(res)) {
+ res <- data.frame(documents=NA, tokens=NA, sentences=NA, paragraphs=NA)
+ }
log.info(verbose, ": ", res$tokens, " tokens\n")
if (as.df)
data.frame(vc = vc, res, stringsAsFactors = FALSE)
diff --git a/R/KorAPQuery.R b/R/KorAPQuery.R
index 9bab575..eb2afbd 100644
--- a/R/KorAPQuery.R
+++ b/R/KorAPQuery.R
@@ -188,15 +188,22 @@
log.info(verbose, "Searching \"", query, "\" in \"", vc, "\"", sep =
"")
res = apiCall(kco, paste0(requestUrl, '&count=0'))
- log.info(verbose, ": ", res$meta$totalResults, " hits")
- if(!is.null(res$meta$cached))
- log.info(verbose, " [cached]\n")
- else
- log.info(verbose, ", took ", res$meta$benchmark, "\n", sep = "")
+ if (is.null(res)) {
+ log.info(verbose, " [failed]\n")
+ message("API call failed.")
+ totalResults <- 0
+ } else {
+ totalResults <-res$meta$totalResults
+ log.info(verbose, ": ", totalResults, " hits")
+ if(!is.null(res$meta$cached))
+ log.info(verbose, " [cached]\n")
+ else
+ log.info(verbose, ", took ", res$meta$benchmark, "\n", sep = "")
+ }
if (as.df)
data.frame(
query = query,
- totalResults = res$meta$totalResults,
+ totalResults = totalResults,
vc = vc,
webUIRequestUrl = webUIRequestUrl,
stringsAsFactors = FALSE
@@ -208,11 +215,11 @@
fields = fields,
requestUrl = requestUrl,
request = request,
- totalResults = res$meta$totalResults,
+ totalResults = totalResults,
vc = vc,
apiResponse = res,
webUIRequestUrl = webUIRequestUrl,
- hasMoreMatches = (res$meta$totalResults > 0),
+ hasMoreMatches = (totalResults > 0),
)
}
})
diff --git a/R/ci.R b/R/ci.R
index a0c04f7..19f8615 100644
--- a/R/ci.R
+++ b/R/ci.R
@@ -40,8 +40,12 @@
x <- enquo(x)
N <- enquo(N)
nas <- df %>%
- dplyr::filter(total <= 0) %>%
+ dplyr::filter(is.na(total) | total <= 0) %>%
mutate(f = NA, conf.low = NA, conf.high = NA)
+
+ if (nrow(df) == nrow(nas))
+ return(nas)
+
df %>%
dplyr::filter(total > 0) %>%
rowwise %>%