-
Notifications
You must be signed in to change notification settings - Fork 2
/
zzz.R
97 lines (84 loc) · 2.22 KB
/
zzz.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
tc <- function(l) Filter(Negate(is.null), l)
argsnull <- function(x) {
if (length(x) == 0) {
NULL
} else {
x
}
}
nmslwr <- function(x) {
stats::setNames(x, tolower(names(x)))
}
itbase <- function() 'https://www.itis.gov/ITISWebService/services/ITISService/'
itjson <- function() 'https://www.itis.gov/ITISWebService/jsonservice/'
itis_solr_url <- function() "https://services.itis.gov"
iturl <- function(x) {
if (!tolower(x) %in% c('json', 'xml')) {
stop("'wt' must be one of 'json' or 'xml'", call. = FALSE)
}
switch(
x,
json = itjson(),
xml = itbase()
)
}
`%-%` <- function(x, y) if (length(x) == 0 || nchar(x) == 0 || is.null(x)) y else x
dr_op <- function(x, y) UseMethod("dr_op")
dr_op.default <- function(x, y) return(NULL)
dr_op.data.frame <- function(x, y) x[, !tolower(names(x)) %in% tolower(y)]
dr_op.list <- function(x, y) x[!tolower(names(x)) %in% tolower(y)]
itis_GET <- function(endpt, args, wt, ...){
args <- argsnull(args)
cli <- crul::HttpClient$new(
url = paste0(iturl(wt), endpt),
opts = list(...)
)
tt <- cli$get(query = args)
tt$raise_for_status()
# sort out encoding - if not found, parse differently
encoding <- NULL
if (!is.null(tt$response_headers$`content-type`)) {
encoding <- strsplit(
strsplit(tt$response_headers$`content-type`, ";")[[1]][2],
"="
)[[1]][2]
}
if (is.null(encoding) || !nzchar(encoding)) {
readBin(tt$content, character())
} else {
tt$parse(encoding)
}
}
parse_raw <- function(x) {
if ((inherits(x, "character") && !nzchar(x)) || is.na(x)) {
return(tibble::as_tibble())
}
jsonlite::fromJSON(x, flatten = TRUE)
}
pick_cols <- function(x, nms) {
UseMethod("pick_cols")
}
pick_cols.default <- function(x, nms) {
return(NULL)
}
pick_cols.data.frame <- function(x, nms) {
if (NROW(x) > 0) {
names(x) <- tolower(names(x))
x[, names(x) %in% tolower(nms)]
} else {
NULL
}
}
pick_cols.list <- function(x, nms) {
if (NROW(x) > 0) {
names(x) <- tolower(names(x))
x[names(x) %in% tolower(nms)]
} else {
NULL
}
}
make_itis_conn <- function(proxy) {
solrium::SolrClient$new(host = "services.itis.gov",
scheme = "https", port = NULL, errors = "complete",
proxy = proxy)
}