/
pasteUrl.R
97 lines (97 loc) · 2.69 KB
/
pasteUrl.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
#' Concatenate strings to form a URL
#'
#' @export
#' @note Updated 2023-09-19.
#'
#' @details
#' Encoding is applied automatically via `utils::URLencode`.
#'
#' @param ... Character strings.
#' Intentionally does not support recycling here, unlike base `paste`.
#' Input of character vector as first argument alone is supported.
#' Errors if `NA` values are present.
#'
#' @param protocol `character(1)`.
#' Desired protocol to use. Defaults to "https" but "http", "ftp", and "s3"
#' (AWS S3) are also supported. Use `"none"` if you want to prepare a URL that
#' already contains a protocol in the first element of the dots.
#'
#' @return `character(1)`.
#' URL path.
#'
#' @examples
#' ## HTTPS.
#' x <- pasteUrl(
#' "r.acidgenomics.com",
#' "packages",
#' "acidbase",
#' protocol = "https"
#' )
#' print(x)
#'
#' ## FTP.
#' x <- pasteUrl(
#' "ftp.ensembl.org",
#' "pub",
#' "release-94",
#' "gtf",
#' "homo_sapiens",
#' "Homo_sapiens.GRCh38.94.gtf.gz",
#' protocol = "ftp"
#' )
#' print(x)
#'
#' ## Automatic encoding support.
#' x <- pasteUrl(
#' "rest.ensembl.org",
#' "info",
#' "assembly",
#' "Homo sapiens",
#' protocol = "https"
#' )
#' print(x)
#'
#' ## Character vector support.
#' vec <- c("r.acidgenomics.com", "packages", "acidbase")
#' x <- pasteUrl(vec, protocol = "https")
#' print(x)
pasteUrl <-
function(...,
protocol = c("none", "https", "http", "ftp", "rsync", "s3")) {
dots <- list(...)
assert(
hasLength(dots),
msg = "Nothing to paste."
)
if (hasLength(dots, n = 1L) && is.character(dots[[1L]])) {
dots <- dots[[1L]]
} else {
assert(
all(bapply(X = dots, FUN = isString)),
msg = paste(
"Dots must only contain character strings.",
"Recycling is intentionally not supported."
)
)
dots <- unlist(x = dots, recursive = FALSE, use.names = FALSE)
}
assert(
isCharacter(dots),
requireNamespaces("utils")
)
protocol <- match.arg(protocol)
## This is useful for FTP servers.
addTrailingSlash <- !identical(dots[[length(dots)]], "/") &&
grepl(pattern = "/$", x = dots[[length(dots)]])
dots <- gsub(pattern = "/$", replacement = "", x = dots)
if (isTRUE(addTrailingSlash)) {
dots <- append(x = dots, values = "")
}
url <- paste(dots, collapse = "/")
if (!identical(protocol, "none")) {
url <- paste0(protocol, "://", url)
}
url <- utils::URLencode(url)
assert(isAUrl(url))
url
}