Skip to content

Commit acc239f

Browse files
fmichonneaufmichonneau
committed
Merge pull request #65 from ropensci/revision
revisions
2 parents 8eb6998 + ccec6ef commit acc239f

File tree

10 files changed

+105
-74
lines changed

10 files changed

+105
-74
lines changed

‎R/api-collections.R

Lines changed: 28 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,28 @@
1+
##' @importFrom assertthat assert_that is.flag
2+
## This endpoint currently returns JSON in XML with mime type as text/html
3+
.collection_find_collections <- function(property = NULL, value = NULL,
4+
verbose = FALSE, ...) {
5+
assertthat::assert_that(assertthat::is.flag(verbose))
6+
req_body <- list()
7+
req_body$verbose <- verbose
8+
res <- otl_POST(path = "collections/find_collections",
9+
body = req_body, ...)
10+
res
11+
}
12+
13+
.collection_properties <- function(...) {
14+
req_body <- list()
15+
res <- otl_POST(path = "collections/properties",
16+
body = req_body, ...)
17+
res
18+
}
19+
20+
21+
.get_collection <- function(owner_id = NULL, collection_name = NULL, ...) {
22+
assertthat::assert_that(assertthat::is.string(owner_id))
23+
assertthat::assert_that(assertthat::is.string(collection_name))
24+
req_body <- list()
25+
res <- otl_GET(path = paste("collections", owner_id, collection_name,
26+
sep = "/"), ...)
27+
res
28+
}

‎R/api-gol.R

Lines changed: 3 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -2,11 +2,7 @@
22
## Summary information about the Graph of Life
33
.gol_about <- function(...) {
44
res <- otl_POST(path="graph/about", body=list(), ...)
5-
cont <- httr::content(res)
6-
if (length(cont) < 1) {
7-
warning("Nothing returned")
8-
}
9-
return(cont)
5+
res
106
}
117

128

@@ -33,8 +29,7 @@
3329
q <- list(study_id=jsonlite::unbox(study_id), tree_id=jsonlite::unbox(tree_id),
3430
git_sha=jsonlite::unbox(git_sha))
3531
res <- otl_POST(path="graph/source_tree", body=q, ...)
36-
cont <- httr::content(res)
37-
return(cont)
32+
res
3833
}
3934

4035
##' @importFrom jsonlite unbox
@@ -53,6 +48,5 @@
5348
q <- list(ott_id=jsonlite::unbox(ott_id), include_lineage=jsonlite::unbox(include_lineage))
5449
}
5550
res <- otl_POST(path="graph/node_info", body=q, ...)
56-
cont <- httr::content(res)
57-
return(cont)
51+
res
5852
}

‎R/api-studies.R

Lines changed: 11 additions & 15 deletions
Original file line numberDiff line numberDiff line change
@@ -23,12 +23,12 @@
2323
} else {
2424
stop("Must supply a \'value\' argument")
2525
}
26+
req_body$verbose <- jsonlite::unbox(verbose)
27+
req_body$exact <- jsonlite::unbox(exact)
2628
res <- otl_POST(path="studies/find_studies/",
27-
body=c(req_body,
28-
jsonlite::unbox(verbose),
29-
jsonlite::unbox(exact)), ...)
30-
cont <- httr::content(res)
31-
return(cont)
29+
body=req_body,
30+
...)
31+
res
3232
}
3333

3434
##' @importFrom jsonlite unbox
@@ -64,17 +64,15 @@
6464
body=c(req_body,
6565
jsonlite::unbox(verbose),
6666
jsonlite::unbox(exact)), ...)
67-
cont <- httr::content(res)
68-
return(cont)
67+
res
6968
}
7069

7170

7271
##' @importFrom httr content
7372
## Return a list of properties that can be used to search studies and trees
7473
.studies_properties <- function() {
7574
res <- otl_POST(path="studies/properties/", body=list())
76-
cont <- httr::content(res)
77-
return(cont)
75+
res
7876
}
7977

8078

@@ -91,8 +89,7 @@
9189
res <- otl_GET(path=paste("study",
9290
paste0(study_id, otl_formats(format)), sep="/"),
9391
...)
94-
cont <- httr::content(res)
95-
return(cont)
92+
res
9693
}
9794

9895

@@ -116,13 +113,12 @@
116113
tip_label <- paste0("/?tip_label=", tip_label)
117114
tree_file <- paste0(tree_id, otl_formats(format), tip_label)
118115
res <- otl_GET(path=paste("study", study_id, "tree", tree_file, sep="/"), ...)
119-
cont <- httr::content(res)
120-
return(cont)
116+
res
121117
}
122118

123119
##' @importFrom httr content
124120
.get_study_meta <- function(study_id, ...) {
125-
httr::content(otl_GET(path= paste("study", study_id, "meta", sep="/"), ...))
121+
otl_GET(path= paste("study", study_id, "meta", sep="/"), ...)
126122
}
127123

128124

@@ -148,7 +144,7 @@
148144
format <- otl_formats(format)
149145
url_stem <- paste("study", study_id, "tree", paste0(tree_id, format), sep="/")
150146
res <- otl_GET(path=paste(url_stem, "?subtree_id=", subtree_id, sep=""), ...)
151-
httr::content(res)
147+
res
152148
}
153149

154150
### Let's not worry about those for now, as their results could be

‎R/api-taxonomy.R

Lines changed: 4 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -2,8 +2,7 @@
22
## Summary information about the OpenTree Taxaonomy (OTT)
33
.taxonomy_about <- function(...) {
44
res <- otl_POST(path="/taxonomy/about", body=list(), ...)
5-
cont <- httr::content(res)
6-
return(cont)
5+
res
76
}
87

98

@@ -27,8 +26,7 @@
2726
include_lineage = jsonlite::unbox(include_lineage),
2827
list_terminal_descendants = jsonlite::unbox(list_terminal_descendants))
2928
res <- otl_POST(path="/taxonomy/taxon", body=q, ...)
30-
cont <- httr::content(res)
31-
return(cont)
29+
res
3230
}
3331

3432

@@ -45,8 +43,7 @@
4543
}
4644
q <- list(ott_id=jsonlite::unbox(ott_id))
4745
res <- otl_POST(path="/taxonomy/subtree", body=q, ...)
48-
cont <- httr::content(res)
49-
return(cont)
46+
res
5047
}
5148

5249

@@ -60,6 +57,5 @@
6057
}
6158
q <- list(ott_ids=ott_ids)
6259
res <- otl_POST(path="/taxonomy/lica", body=q, ...)
63-
cont <- httr::content(res)
64-
return(cont)
60+
res
6561
}

‎R/api-tnrs.R

Lines changed: 3 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -40,17 +40,15 @@
4040
q <- q[!toKeep]
4141

4242
res <- otl_POST("tnrs/match_names", body=q, ...)
43-
cont <- httr::content(res)
44-
return(cont)
43+
res
4544
}
4645

4746

4847
##' @importFrom httr content
4948
## Get OpenTree TNRS contexts
5049
.tnrs_contexts <- function(...) {
5150
res <- otl_POST("tnrs/contexts", body=list(), ...)
52-
cont <- httr::content(res)
53-
return(cont)
51+
res
5452
}
5553

5654

@@ -63,6 +61,5 @@
6361
}
6462
q <- list(names=names)
6563
res <- otl_POST("tnrs/infer_context", body=q, ...)
66-
cont <- httr::content(res)
67-
return(cont)
64+
res
6865
}

‎R/api-tol.R

Lines changed: 4 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -7,8 +7,7 @@
77
}
88
q <- list(study_list=jsonlite::unbox(study_list))
99
res <- otl_POST(path="tree_of_life/about", body=q, ...)
10-
cont <- httr::content(res)
11-
return(invisible(cont))
10+
res
1211
}
1312

1413

@@ -26,8 +25,7 @@
2625
q <- list(ott_ids = ott_ids)
2726
}
2827
res <- otl_POST(path="tree_of_life/mrca", body=q, ...)
29-
cont <- httr::content(res)
30-
return(cont)
28+
res
3129
}
3230

3331

@@ -47,8 +45,7 @@
4745
q <- list(ott_id = jsonlite::unbox(ott_id))
4846
}
4947
res <- otl_POST(path="tree_of_life/subtree", body=q, ...)
50-
cont <- httr::content(res)
51-
return(cont)
48+
res
5249
}
5350

5451

@@ -71,6 +68,5 @@
7168
q <- list(ott_ids = ott_ids)
7269

7370
res <- otl_POST("tree_of_life/induced_subtree", body=q, ...)
74-
cont <- httr::content(res)
75-
return(cont)
71+
res
7672
}

‎R/base.R

Lines changed: 27 additions & 19 deletions
Original file line numberDiff line numberDiff line change
@@ -14,31 +14,49 @@ otl_version <- function(version) {
1414
}
1515
}
1616

17+
18+
# Take a request object and return list (if JSON) or plain text (if another
19+
# type)
1720
##' @importFrom httr content
1821
##' @importFrom jsonlite fromJSON
1922
otl_parse <- function(req) {
20-
txt <- httr::content(req, as="text")
21-
if (identical(txt, "")) {
23+
if (grepl("application/json", req[["headers"]][["content-type"]]) ){
24+
return(jsonlite::fromJSON(httr::content(req, "text", encoding = "UTF-8"), simplifyVector = FALSE))
25+
}
26+
txt <- httr::content(req, as="text", encoding = "UTF-8")
27+
if(identical(txt, "")){
2228
stop("No output to parse; check your query.", call. = FALSE)
2329
}
24-
if (substr(txt, 1, 1) == "{") {
25-
jsonlite::fromJSON(txt, simplifyVector = FALSE)$description
26-
} else txt
30+
txt
31+
}
32+
33+
otl_check_error <- function(cont) {
34+
if (is.list(cont)) {
35+
if (exists("description", cont)) {
36+
if (exists("Error", cont$description)) {
37+
stop(paste("Error: ", cont$description$error, "\n", sep = ""))
38+
} else if (exists("message", cont)) {
39+
stop(paste("Message: ", cont$descrption$message, "\n", sep = ""))
40+
}
41+
}
42+
}
2743
}
2844

45+
## Check and parse result of query
2946
otl_check <- function(req) {
30-
otl_check_error(req)
3147
if (!req$status_code < 400) {
3248
msg <- otl_parse(req)
3349
stop("HTTP failure: ", req$status_code, "\n", msg, call. = FALSE)
3450
}
51+
desc <- otl_parse(req)
52+
otl_check_error(desc)
53+
desc
3554
}
3655

3756
##' @importFrom httr GET
3857
otl_GET <- function(path, dev_url = FALSE, otl_v = otl_version(), ...) {
3958
req <- httr::GET(otl_url(), path=paste(otl_v, path, sep="/"), ...)
4059
otl_check(req)
41-
req
4260
}
4361

4462
##' @importFrom jsonlite toJSON
@@ -52,20 +70,9 @@ otl_POST <- function(path, body, dev_url = FALSE, otl_v = otl_version(), ...) {
5270
path=paste(otl_v, path, sep="/"),
5371
body=body_json, ...)
5472
otl_check(req)
55-
req
5673
}
5774

58-
##' @importFrom httr content
59-
otl_check_error <- function(req) {
60-
cont <- httr::content(req)
61-
if (is.list(cont)) {
62-
if (exists("error", cont)) {
63-
stop(paste("Error: ", cont$error, "\n", sep = ""))
64-
} else if (exists("message", cont)) {
65-
stop(paste("Message: ", cont$message, "\n", sep = ""))
66-
}
67-
}
68-
}
75+
6976

7077
otl_formats <- function(format) {
7178
switch(tolower(format),
@@ -76,6 +83,7 @@ otl_formats <- function(format) {
7683
"") #fall through is no extension = nex(j)son
7784
}
7885

86+
7987
## Strip all characters except the ottId from a OpenTree label (internal or terminal)
8088
otl_ottid_from_label <- function(label) {
8189
return(as.numeric(gsub("(.+[ _]ott)([0-9]+)", "\\2", label)));

‎R/studies.R

Lines changed: 8 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -2,10 +2,12 @@
22
##' studies and trees used in the synthetic tree.
33
##'
44
##' The list returned has 2 elements \code{tree_properties} and
5-
##' \code{studies_properties}. Each of these elements lists
6-
##' theadditional arguments to customize the API request properties
7-
##' that can be used to search for trees and studies that are
8-
##' contributing to the synthetic tree.
5+
##' \code{studies_properties}. Each of these elements lists additional
6+
##' arguments to customize the API request properties that can be used
7+
##' to search for trees and studies that are contributing to the
8+
##' synthetic tree. The definitions of these properties are available
9+
##' from
10+
##' \url{https://github.com/OpenTreeOfLife/phylesystem-api/wiki/NexSON}
911
##'
1012
##' @title Properties of the Studies
1113
##' @param ... additional arguments to customize the API request (see
@@ -79,7 +81,8 @@ studies_properties <- function(...) {
7981
studies_find_studies <- function(property=NULL, value=NULL, verbose=FALSE,
8082
exact=FALSE, detailed = TRUE, ...) {
8183
.res <- .studies_find_studies(property = property, value = value,
82-
verbose = verbose, exact = exact, ...)
84+
verbose = verbose, exact = exact, ...)
85+
8386
res <- vapply(.res[["matched_studies"]],
8487
function(x) x[["ot:studyId"]],
8588
character(1))

‎man/studies_properties.Rd

Lines changed: 6 additions & 4 deletions
Some generated files are not rendered by default. Learn more about customizing how changed files appear on GitHub.

‎tests/testthat/test-api-studies.R

Lines changed: 11 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -82,7 +82,18 @@ test_that("both property & value need to be provided for .studies_find_trees", {
8282
"Must supply")
8383
})
8484

85+
test_that("exact works as intended", {
86+
skip_on_cran()
87+
expect_equal(length(.studies_find_studies("ot:focalCladeOTTTaxonName",
88+
"felidae", exact = TRUE)$matched_studies), 0)
89+
})
90+
8591

92+
test_that("exact works as intended", {
93+
skip_on_cran()
94+
expect_true(length(.studies_find_studies("ot:focalCladeOTTTaxonName",
95+
"Felidae", exact = TRUE)$matched_studies) >= 1)
96+
})
8697

8798
############################################################################
8899
## .get_study ##

0 commit comments

Comments
 (0)