Skip to content

Commit 1a94d90

Browse files
hadleyhadley
committed
Set up basic structure
1 parent 8e748a1 commit 1a94d90

26 files changed

+506
-2
lines changed

‎.Rbuildignore

+1
Original file line numberDiff line numberDiff line change
@@ -1,2 +1,3 @@
11
^httr2\.Rproj$
22
^\.Rproj\.user$
3+
^LICENSE\.md$

‎DESCRIPTION

+11-2
Original file line numberDiff line numberDiff line change
@@ -9,8 +9,17 @@ Authors@R:
99
person(given = "RStudio",
1010
role = c("cph", "fnd")))
1111
Description: What the package does (one paragraph).
12-
License: `use_mit_license()`, `use_gpl3_license()` or friends to pick a
13-
license
12+
License: MIT + file LICENSE
1413
Encoding: UTF-8
1514
Roxygen: list(markdown = TRUE)
1615
RoxygenNote: 7.1.1
16+
Imports:
17+
cli,
18+
curl,
19+
ellipsis,
20+
glue,
21+
httr,
22+
lifecycle,
23+
magrittr,
24+
rlang,
25+
withr

‎LICENSE

+2
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,2 @@
1+
YEAR: 2021
2+
COPYRIGHT HOLDER: httr2 authors

‎LICENSE.md

+21
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,21 @@
1+
# MIT License
2+
3+
Copyright (c) 2021 httr2 authors
4+
5+
Permission is hereby granted, free of charge, to any person obtaining a copy
6+
of this software and associated documentation files (the "Software"), to deal
7+
in the Software without restriction, including without limitation the rights
8+
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
9+
copies of the Software, and to permit persons to whom the Software is
10+
furnished to do so, subject to the following conditions:
11+
12+
The above copyright notice and this permission notice shall be included in all
13+
copies or substantial portions of the Software.
14+
15+
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
16+
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
17+
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
18+
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
19+
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
20+
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
21+
SOFTWARE.

‎NAMESPACE

+5
Original file line numberDiff line numberDiff line change
@@ -1,2 +1,7 @@
11
# Generated by roxygen2: do not edit by hand
22

3+
export("%>%")
4+
import(rlang)
5+
importFrom(glue,glue)
6+
importFrom(lifecycle,deprecated)
7+
importFrom(magrittr,"%>%")

‎R/compat-purrr.R

+198
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,198 @@
1+
# nocov start - compat-purrr.R
2+
# Latest version: https://github.com/r-lib/rlang/blob/master/R/compat-purrr.R
3+
4+
# This file provides a minimal shim to provide a purrr-like API on top of
5+
# base R functions. They are not drop-in replacements but allow a similar style
6+
# of programming.
7+
#
8+
# Changelog:
9+
# 2020-04-14:
10+
# * Removed `pluck*()` functions
11+
# * Removed `*_cpl()` functions
12+
# * Used `as_function()` to allow use of `~`
13+
# * Used `.` prefix for helpers
14+
#
15+
# 2021-05-21:
16+
# * Fixed "object `x` not found" error in `imap()` (@mgirlich)
17+
18+
map <- function(.x, .f, ...) {
19+
.f <- as_function(.f, env = global_env())
20+
lapply(.x, .f, ...)
21+
}
22+
walk <- function(.x, .f, ...) {
23+
map(.x, .f, ...)
24+
invisible(.x)
25+
}
26+
27+
map_lgl <- function(.x, .f, ...) {
28+
.rlang_purrr_map_mold(.x, .f, logical(1), ...)
29+
}
30+
map_int <- function(.x, .f, ...) {
31+
.rlang_purrr_map_mold(.x, .f, integer(1), ...)
32+
}
33+
map_dbl <- function(.x, .f, ...) {
34+
.rlang_purrr_map_mold(.x, .f, double(1), ...)
35+
}
36+
map_chr <- function(.x, .f, ...) {
37+
.rlang_purrr_map_mold(.x, .f, character(1), ...)
38+
}
39+
.rlang_purrr_map_mold <- function(.x, .f, .mold, ...) {
40+
.f <- as_function(.f, env = global_env())
41+
out <- vapply(.x, .f, .mold, ..., USE.NAMES = FALSE)
42+
names(out) <- names(.x)
43+
out
44+
}
45+
46+
map2 <- function(.x, .y, .f, ...) {
47+
.f <- as_function(.f, env = global_env())
48+
out <- mapply(.f, .x, .y, MoreArgs = list(...), SIMPLIFY = FALSE)
49+
if (length(out) == length(.x)) {
50+
set_names(out, names(.x))
51+
} else {
52+
set_names(out, NULL)
53+
}
54+
}
55+
map2_lgl <- function(.x, .y, .f, ...) {
56+
as.vector(map2(.x, .y, .f, ...), "logical")
57+
}
58+
map2_int <- function(.x, .y, .f, ...) {
59+
as.vector(map2(.x, .y, .f, ...), "integer")
60+
}
61+
map2_dbl <- function(.x, .y, .f, ...) {
62+
as.vector(map2(.x, .y, .f, ...), "double")
63+
}
64+
map2_chr <- function(.x, .y, .f, ...) {
65+
as.vector(map2(.x, .y, .f, ...), "character")
66+
}
67+
imap <- function(.x, .f, ...) {
68+
map2(.x, names(.x) %||% seq_along(.x), .f, ...)
69+
}
70+
71+
pmap <- function(.l, .f, ...) {
72+
.f <- as.function(.f)
73+
args <- .rlang_purrr_args_recycle(.l)
74+
do.call("mapply", c(
75+
FUN = list(quote(.f)),
76+
args, MoreArgs = quote(list(...)),
77+
SIMPLIFY = FALSE, USE.NAMES = FALSE
78+
))
79+
}
80+
.rlang_purrr_args_recycle <- function(args) {
81+
lengths <- map_int(args, length)
82+
n <- max(lengths)
83+
84+
stopifnot(all(lengths == 1L | lengths == n))
85+
to_recycle <- lengths == 1L
86+
args[to_recycle] <- map(args[to_recycle], function(x) rep.int(x, n))
87+
88+
args
89+
}
90+
91+
keep <- function(.x, .f, ...) {
92+
.x[.rlang_purrr_probe(.x, .f, ...)]
93+
}
94+
discard <- function(.x, .p, ...) {
95+
sel <- .rlang_purrr_probe(.x, .p, ...)
96+
.x[is.na(sel) | !sel]
97+
}
98+
map_if <- function(.x, .p, .f, ...) {
99+
matches <- .rlang_purrr_probe(.x, .p)
100+
.x[matches] <- map(.x[matches], .f, ...)
101+
.x
102+
}
103+
.rlang_purrr_probe <- function(.x, .p, ...) {
104+
if (is_logical(.p)) {
105+
stopifnot(length(.p) == length(.x))
106+
.p
107+
} else {
108+
.p <- as_function(.p, env = global_env())
109+
map_lgl(.x, .p, ...)
110+
}
111+
}
112+
113+
compact <- function(.x) {
114+
Filter(length, .x)
115+
}
116+
117+
transpose <- function(.l) {
118+
inner_names <- names(.l[[1]])
119+
if (is.null(inner_names)) {
120+
fields <- seq_along(.l[[1]])
121+
} else {
122+
fields <- set_names(inner_names)
123+
}
124+
125+
map(fields, function(i) {
126+
map(.l, .subset2, i)
127+
})
128+
}
129+
130+
every <- function(.x, .p, ...) {
131+
.p <- as_function(.p, env = global_env())
132+
133+
for (i in seq_along(.x)) {
134+
if (!rlang::is_true(.p(.x[[i]], ...))) return(FALSE)
135+
}
136+
TRUE
137+
}
138+
some <- function(.x, .p, ...) {
139+
.p <- as_function(.p, env = global_env())
140+
141+
for (i in seq_along(.x)) {
142+
if (rlang::is_true(.p(.x[[i]], ...))) return(TRUE)
143+
}
144+
FALSE
145+
}
146+
negate <- function(.p) {
147+
.p <- as_function(.p, env = global_env())
148+
function(...) !.p(...)
149+
}
150+
151+
reduce <- function(.x, .f, ..., .init) {
152+
f <- function(x, y) .f(x, y, ...)
153+
Reduce(f, .x, init = .init)
154+
}
155+
reduce_right <- function(.x, .f, ..., .init) {
156+
f <- function(x, y) .f(y, x, ...)
157+
Reduce(f, .x, init = .init, right = TRUE)
158+
}
159+
accumulate <- function(.x, .f, ..., .init) {
160+
f <- function(x, y) .f(x, y, ...)
161+
Reduce(f, .x, init = .init, accumulate = TRUE)
162+
}
163+
accumulate_right <- function(.x, .f, ..., .init) {
164+
f <- function(x, y) .f(y, x, ...)
165+
Reduce(f, .x, init = .init, right = TRUE, accumulate = TRUE)
166+
}
167+
168+
detect <- function(.x, .f, ..., .right = FALSE, .p = is_true) {
169+
.p <- as_function(.p, env = global_env())
170+
.f <- as_function(.f, env = global_env())
171+
172+
for (i in .rlang_purrr_index(.x, .right)) {
173+
if (.p(.f(.x[[i]], ...))) {
174+
return(.x[[i]])
175+
}
176+
}
177+
NULL
178+
}
179+
detect_index <- function(.x, .f, ..., .right = FALSE, .p = is_true) {
180+
.p <- as_function(.p, env = global_env())
181+
.f <- as_function(.f, env = global_env())
182+
183+
for (i in .rlang_purrr_index(.x, .right)) {
184+
if (.p(.f(.x[[i]], ...))) {
185+
return(i)
186+
}
187+
}
188+
0L
189+
}
190+
.rlang_purrr_index <- function(x, right = FALSE) {
191+
idx <- seq_along(x)
192+
if (right) {
193+
idx <- rev(idx)
194+
}
195+
idx
196+
}
197+
198+
# nocov end

‎R/httr2-package.R

+9
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,9 @@
1+
#' @keywords internal
2+
"_PACKAGE"
3+
4+
## usethis namespace: start
5+
#' @import rlang
6+
#' @importFrom glue glue
7+
#' @importFrom lifecycle deprecated
8+
## usethis namespace: end
9+
NULL

‎R/req-body.R

+25
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,25 @@
1+
2+
req_body_none <- function(req) {
3+
req_options_set(req, post = TRUE, nobody = TRUE)
4+
}
5+
6+
req_body_file <- function(req, path) {
7+
8+
}
9+
10+
req_body_raw <- function(req, body) {
11+
12+
}
13+
14+
req_body_json <- function(req, ...) {
15+
16+
}
17+
18+
req_body_form <- function(req, ...) {
19+
20+
}
21+
22+
req_body_multipart <- function(req, ...) {
23+
24+
}
25+

‎R/req-fetch.R

+96
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,96 @@
1+
2+
req_fetch <- function(req, method = NULL) {
3+
url <- req_url_get(req)
4+
handle <- req_handle(req, method)
5+
6+
res <- curl::curl_fetch_memory(url, handle)
7+
8+
new_response(
9+
url = res$url,
10+
status_code = res$status_code,
11+
type = httr::parse_media(res$type),
12+
headers = curl::parse_headers_list(res$headers),
13+
body = res$content,
14+
times = res$times
15+
)
16+
}
17+
18+
19+
req_handle <- function(req, method = NULL) {
20+
if (!is.null(method)) {
21+
req <- req_method_set(req, method)
22+
}
23+
24+
handle <- curl::new_handle()
25+
curl::handle_setheaders(handle, .list = req$headers)
26+
curl::handle_setopt(handle, .list = req$options)
27+
handle
28+
}
29+
30+
req_method_set <- function(req, method) {
31+
method <- toupper(method)
32+
33+
# First reset all options - this still needs more thought since
34+
# calling req_body_none() and then req_method_set(, "POST") will
35+
# undo the desired effect. Maybe reserve engineer current and only
36+
# set if different? Maybe set up full from -> to matrix.
37+
req$options$httpget <- NULL
38+
req$options$post <- NULL
39+
req$options$nobody <- NULL
40+
req$options$customrequest <- NULL
41+
42+
switch(method,
43+
GET = req_options_set(req, httpget = TRUE),
44+
POST = req_options_set(req, post = TRUE),
45+
HEAD = req_options_set(req, nobody = TRUE),
46+
req_options_set(req, customrequest = method)
47+
)
48+
}
49+
50+
req_fetch <- function(req, method = NULL) {
51+
url <- req_url_get(req)
52+
handle <- req_handle(req, method)
53+
54+
res <- curl::curl_fetch_memory(url, handle)
55+
56+
new_response(
57+
url = res$url,
58+
status_code = res$status_code,
59+
type = httr::parse_media(res$type),
60+
headers = curl::parse_headers_list(res$headers),
61+
body = res$content,
62+
times = res$times
63+
)
64+
}
65+
66+
67+
req_handle <- function(req, method = NULL) {
68+
if (!is.null(method)) {
69+
req <- req_method_set(req, method)
70+
}
71+
72+
handle <- curl::new_handle()
73+
curl::handle_setheaders(handle, .list = req$headers)
74+
curl::handle_setopt(handle, .list = req$options)
75+
handle
76+
}
77+
78+
req_method_set <- function(req, method) {
79+
method <- toupper(method)
80+
81+
# First reset all options - this still needs more thought since
82+
# calling req_body_none() and then req_method_set(, "POST") will
83+
# undo the desired effect. Maybe reserve engineer current and only
84+
# set if different? Maybe set up full from -> to matrix.
85+
req$options$httpget <- NULL
86+
req$options$post <- NULL
87+
req$options$nobody <- NULL
88+
req$options$customrequest <- NULL
89+
90+
switch(method,
91+
GET = req_options_set(req, httpget = TRUE),
92+
POST = req_options_set(req, post = TRUE),
93+
HEAD = req_options_set(req, nobody = TRUE),
94+
req_options_set(req, customrequest = method)
95+
)
96+
}

‎R/req-headers.R

+6
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,6 @@
1+
2+
req_headers_set <- function(req, ...) {
3+
headers <- list2(...)
4+
req$url$headers <- utils::modifyList(req$url$headers, headers)
5+
req
6+
}

0 commit comments

Comments
 (0)