From c040290d9ac99ea4fed1749e2881447f392f5296 Mon Sep 17 00:00:00 2001 From: your name Date: Tue, 9 Jan 2024 22:23:21 -0500 Subject: [PATCH 01/10] refactor: add full standalone-purr script Removes copied code from utils.R --- R/import-standalone-purrr.R | 240 ++++++++++++++++++++++++++++++++++++ R/utils.R | 44 ------- 2 files changed, 240 insertions(+), 44 deletions(-) create mode 100644 R/import-standalone-purrr.R diff --git a/R/import-standalone-purrr.R b/R/import-standalone-purrr.R new file mode 100644 index 00000000..623142a0 --- /dev/null +++ b/R/import-standalone-purrr.R @@ -0,0 +1,240 @@ +# Standalone file: do not edit by hand +# Source: +# ---------------------------------------------------------------------- +# +# --- +# repo: r-lib/rlang +# file: standalone-purrr.R +# last-updated: 2023-02-23 +# license: https://unlicense.org +# imports: rlang +# --- +# +# This file provides a minimal shim to provide a purrr-like API on top of +# base R functions. They are not drop-in replacements but allow a similar style +# of programming. +# +# ## Changelog +# +# 2023-02-23: +# * Added `list_c()` +# +# 2022-06-07: +# * `transpose()` is now more consistent with purrr when inner names +# are not congruent (#1346). +# +# 2021-12-15: +# * `transpose()` now supports empty lists. +# +# 2021-05-21: +# * Fixed "object `x` not found" error in `imap()` (@mgirlich) +# +# 2020-04-14: +# * Removed `pluck*()` functions +# * Removed `*_cpl()` functions +# * Used `as_function()` to allow use of `~` +# * Used `.` prefix for helpers +# +# nocov start + +map <- function(.x, .f, ...) { + .f <- as_function(.f, env = global_env()) + lapply(.x, .f, ...) +} +walk <- function(.x, .f, ...) { + map(.x, .f, ...) + invisible(.x) +} + +map_lgl <- function(.x, .f, ...) { + .rlang_purrr_map_mold(.x, .f, logical(1), ...) +} +map_int <- function(.x, .f, ...) { + .rlang_purrr_map_mold(.x, .f, integer(1), ...) +} +map_dbl <- function(.x, .f, ...) { + .rlang_purrr_map_mold(.x, .f, double(1), ...) +} +map_chr <- function(.x, .f, ...) { + .rlang_purrr_map_mold(.x, .f, character(1), ...) +} +.rlang_purrr_map_mold <- function(.x, .f, .mold, ...) { + .f <- as_function(.f, env = global_env()) + out <- vapply(.x, .f, .mold, ..., USE.NAMES = FALSE) + names(out) <- names(.x) + out +} + +map2 <- function(.x, .y, .f, ...) { + .f <- as_function(.f, env = global_env()) + out <- mapply(.f, .x, .y, MoreArgs = list(...), SIMPLIFY = FALSE) + if (length(out) == length(.x)) { + set_names(out, names(.x)) + } else { + set_names(out, NULL) + } +} +map2_lgl <- function(.x, .y, .f, ...) { + as.vector(map2(.x, .y, .f, ...), "logical") +} +map2_int <- function(.x, .y, .f, ...) { + as.vector(map2(.x, .y, .f, ...), "integer") +} +map2_dbl <- function(.x, .y, .f, ...) { + as.vector(map2(.x, .y, .f, ...), "double") +} +map2_chr <- function(.x, .y, .f, ...) { + as.vector(map2(.x, .y, .f, ...), "character") +} +imap <- function(.x, .f, ...) { + map2(.x, names(.x) %||% seq_along(.x), .f, ...) +} + +pmap <- function(.l, .f, ...) { + .f <- as.function(.f) + args <- .rlang_purrr_args_recycle(.l) + do.call("mapply", c( + FUN = list(quote(.f)), + args, MoreArgs = quote(list(...)), + SIMPLIFY = FALSE, USE.NAMES = FALSE + )) +} +.rlang_purrr_args_recycle <- function(args) { + lengths <- map_int(args, length) + n <- max(lengths) + + stopifnot(all(lengths == 1L | lengths == n)) + to_recycle <- lengths == 1L + args[to_recycle] <- map(args[to_recycle], function(x) rep.int(x, n)) + + args +} + +keep <- function(.x, .f, ...) { + .x[.rlang_purrr_probe(.x, .f, ...)] +} +discard <- function(.x, .p, ...) { + sel <- .rlang_purrr_probe(.x, .p, ...) + .x[is.na(sel) | !sel] +} +map_if <- function(.x, .p, .f, ...) { + matches <- .rlang_purrr_probe(.x, .p) + .x[matches] <- map(.x[matches], .f, ...) + .x +} +.rlang_purrr_probe <- function(.x, .p, ...) { + if (is_logical(.p)) { + stopifnot(length(.p) == length(.x)) + .p + } else { + .p <- as_function(.p, env = global_env()) + map_lgl(.x, .p, ...) + } +} + +compact <- function(.x) { + Filter(length, .x) +} + +transpose <- function(.l) { + if (!length(.l)) { + return(.l) + } + + inner_names <- names(.l[[1]]) + + if (is.null(inner_names)) { + fields <- seq_along(.l[[1]]) + } else { + fields <- set_names(inner_names) + .l <- map(.l, function(x) { + if (is.null(names(x))) { + set_names(x, inner_names) + } else { + x + } + }) + } + + # This way missing fields are subsetted as `NULL` instead of causing + # an error + .l <- map(.l, as.list) + + map(fields, function(i) { + map(.l, .subset2, i) + }) +} + +every <- function(.x, .p, ...) { + .p <- as_function(.p, env = global_env()) + + for (i in seq_along(.x)) { + if (!rlang::is_true(.p(.x[[i]], ...))) return(FALSE) + } + TRUE +} +some <- function(.x, .p, ...) { + .p <- as_function(.p, env = global_env()) + + for (i in seq_along(.x)) { + if (rlang::is_true(.p(.x[[i]], ...))) return(TRUE) + } + FALSE +} +negate <- function(.p) { + .p <- as_function(.p, env = global_env()) + function(...) !.p(...) +} + +reduce <- function(.x, .f, ..., .init) { + f <- function(x, y) .f(x, y, ...) + Reduce(f, .x, init = .init) +} +reduce_right <- function(.x, .f, ..., .init) { + f <- function(x, y) .f(y, x, ...) + Reduce(f, .x, init = .init, right = TRUE) +} +accumulate <- function(.x, .f, ..., .init) { + f <- function(x, y) .f(x, y, ...) + Reduce(f, .x, init = .init, accumulate = TRUE) +} +accumulate_right <- function(.x, .f, ..., .init) { + f <- function(x, y) .f(y, x, ...) + Reduce(f, .x, init = .init, right = TRUE, accumulate = TRUE) +} + +detect <- function(.x, .f, ..., .right = FALSE, .p = is_true) { + .p <- as_function(.p, env = global_env()) + .f <- as_function(.f, env = global_env()) + + for (i in .rlang_purrr_index(.x, .right)) { + if (.p(.f(.x[[i]], ...))) { + return(.x[[i]]) + } + } + NULL +} +detect_index <- function(.x, .f, ..., .right = FALSE, .p = is_true) { + .p <- as_function(.p, env = global_env()) + .f <- as_function(.f, env = global_env()) + + for (i in .rlang_purrr_index(.x, .right)) { + if (.p(.f(.x[[i]], ...))) { + return(i) + } + } + 0L +} +.rlang_purrr_index <- function(x, right = FALSE) { + idx <- seq_along(x) + if (right) { + idx <- rev(idx) + } + idx +} + +list_c <- function(x) { + inject(c(!!!x)) +} + +# nocov end diff --git a/R/utils.R b/R/utils.R index eec1181f..544dd912 100644 --- a/R/utils.R +++ b/R/utils.R @@ -6,50 +6,6 @@ ) } -# --- -# repo: r-lib/rlang -# file: standalone-purrr.R -# last-updated: 2023-02-23 -# license: https://unlicense.org -# imports: rlang -# --- -#' map and keep (from standalone-purrr.R) -#' -#' @noRd -map <- function(.x, .f, ...) { - .f <- rlang::as_function(.f, env = rlang::global_env()) - lapply(.x, .f, ...) -} - -#' @noRd -map_lgl <- function(.x, .f, ...) { - .rlang_purrr_map_mold(.x, .f, logical(1), ...) -} - -#' @noRd -.rlang_purrr_map_mold <- function(.x, .f, .mold, ...) { - .f <- as_function(.f, env = global_env()) - out <- vapply(.x, .f, .mold, ..., USE.NAMES = FALSE) - names(out) <- names(.x) - out -} - -#' @noRd -keep <- function(.x, .f, ...) { - .x[.rlang_purrr_probe(.x, .f, ...)] -} - -#' @noRd -.rlang_purrr_probe <- function(.x, .p, ...) { - if (is_logical(.p)) { - stopifnot(length(.p) == length(.x)) - .p - } else { - .p <- as_function(.p, env = global_env()) - map_lgl(.x, .p, ...) - } -} - #' Wrapper for cli::cli_progress_along #' #' @param action String with the action to display in the progress message. From fc7ecce100004b2bb81060f628d9ea580ba1c91e Mon Sep 17 00:00:00 2001 From: your name Date: Tue, 9 Jan 2024 22:30:35 -0500 Subject: [PATCH 02/10] refactor: update select_cols based on example in eval_select docs --- R/field_config.R | 2 +- R/read_airtable.R | 4 ++-- R/update_records.R | 43 +++++++++++++++++++++++++++++++------------ 3 files changed, 34 insertions(+), 15 deletions(-) diff --git a/R/field_config.R b/R/field_config.R index df55c3ed..3e60e924 100644 --- a/R/field_config.R +++ b/R/field_config.R @@ -132,7 +132,7 @@ make_list_of_lists <- function(data, data <- select_cols( tidyselect::any_of(cols), .data = data, - call = call + error_call = call ) } diff --git a/R/read_airtable.R b/R/read_airtable.R index 873e5644..90052767 100644 --- a/R/read_airtable.R +++ b/R/read_airtable.R @@ -592,7 +592,7 @@ resp_body_records <- function(resp, records <- select_cols( tidyselect::any_of(metadata), .data = records, - call = call + error_call = call ) record_nm <- names(records) @@ -652,6 +652,6 @@ arrange_record_cols <- function(records, select_cols( tidyselect::any_of(c(metadata_nm, model_nm)), .data = records, - call = call + error_call = call ) } diff --git a/R/update_records.R b/R/update_records.R index 05ce209e..3040f293 100644 --- a/R/update_records.R +++ b/R/update_records.R @@ -312,22 +312,41 @@ get_data_columns <- function(data, #' Get names of selected columns #' #' @noRd -get_data_colnames <- function(..., .data, .drop = FALSE, call = caller_env()) { - names(select_cols(..., .data = .data, .drop = .drop, call = call)) +get_data_colnames <- function(..., + .data, + call = caller_env()) { + names(select_cols(..., .data = .data, error_call = call)) } #' Use tidyselect to pull a column from a data frame #' #' @noRd #' @importFrom tidyselect eval_select -#' @importFrom rlang expr -select_cols <- function(..., .data, .drop = FALSE, call = caller_env()) { - .data[, - tidyselect::eval_select( - expr(c(...)), - data = .data, - error_call = call - ), - drop = .drop - ] +select_cols <- function(..., + .data, + .field = NULL, + .strict = TRUE, + .include = NULL, + .exclude = NULL, + .name_spec = NULL, + .allow_rename = TRUE, + .allow_empty = TRUE, + .allow_predicates = TRUE, + .env = caller_env(), + error_call = caller_env()) { + pos <- tidyselect::eval_select( + expr = expr(c({{ .field }}, ...)), + data = .data, + env = .env, + strict = .strict, + include = .include, + exclude = .exclude, + name_spec = .name_spec, + allow_rename = .allow_rename, + allow_empty = .allow_empty, + allow_predicates = .allow_predicates, + error_call = error_call + ) + + set_names(.data[pos], names(pos)) } From 4093362d66c87ed5c891344feb555d6da5399473 Mon Sep 17 00:00:00 2001 From: your name Date: Tue, 9 Jan 2024 22:30:48 -0500 Subject: [PATCH 03/10] refactor: update NAMESPACE --- NAMESPACE | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/NAMESPACE b/NAMESPACE index 3349f394..bd0c5e02 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -76,11 +76,20 @@ importFrom(httr2,req_user_agent) importFrom(httr2,request) importFrom(httr2,resp_body_json) importFrom(lifecycle,deprecated) +importFrom(rlang,"%||%") importFrom(rlang,call_name) +importFrom(rlang,caller_arg) importFrom(rlang,caller_call) +importFrom(rlang,caller_env) importFrom(rlang,current_env) importFrom(rlang,exec) importFrom(rlang,expr) +importFrom(rlang,is_empty) +importFrom(rlang,is_false) +importFrom(rlang,is_null) +importFrom(rlang,is_string) +importFrom(rlang,is_true) +importFrom(rlang,local_options) importFrom(rlang,with_options) importFrom(rlang,zap) importFrom(tibble,as_tibble) From b5573954fe5b2f4086de66f1565b34c48a16a66f Mon Sep 17 00:00:00 2001 From: your name Date: Tue, 9 Jan 2024 22:32:18 -0500 Subject: [PATCH 04/10] feat: add draft `download_attachment_field()` function --- NAMESPACE | 10 ----- R/attachments.R | 67 ++++++++++++++++++++++++++++++++ man/download_attachment_field.Rd | 35 +++++++++++++++++ 3 files changed, 102 insertions(+), 10 deletions(-) create mode 100644 R/attachments.R create mode 100644 man/download_attachment_field.Rd diff --git a/NAMESPACE b/NAMESPACE index bd0c5e02..921686d3 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -76,20 +76,10 @@ importFrom(httr2,req_user_agent) importFrom(httr2,request) importFrom(httr2,resp_body_json) importFrom(lifecycle,deprecated) -importFrom(rlang,"%||%") importFrom(rlang,call_name) -importFrom(rlang,caller_arg) importFrom(rlang,caller_call) -importFrom(rlang,caller_env) importFrom(rlang,current_env) importFrom(rlang,exec) -importFrom(rlang,expr) -importFrom(rlang,is_empty) -importFrom(rlang,is_false) -importFrom(rlang,is_null) -importFrom(rlang,is_string) -importFrom(rlang,is_true) -importFrom(rlang,local_options) importFrom(rlang,with_options) importFrom(rlang,zap) importFrom(tibble,as_tibble) diff --git a/R/attachments.R b/R/attachments.R new file mode 100644 index 00000000..a9a2bd64 --- /dev/null +++ b/R/attachments.R @@ -0,0 +1,67 @@ +#' Download files from an Airtable attachment field +#' +#' @description +#' Learn more about the attachment field type: +#' +#' +#' Learn more about attachments in Airtable: +#' +#' +#' @param data An Airtable data frame with an attachment list column selected +#' with the field parameter *or* an attachment list column. +#' @param field Attachment field or column name as string or tidyselect function. +#' @param path Path to download file. +#' @inheritParams rlang::args_error_context +#' @keywords internal +download_attachment_field <- function(data, + field = NULL, + path = NULL, + ..., + call = caller_env()) { + if (!is.null(field)) { + check_data_frame(data, call = call) + data <- select_cols(.data = data, .field = field, call = call) + ncol_data <- ncol(data) + + if (ncol_data > 1) { + cli::cli_abort( + "{.arg field} must select only one attachment column, not {ncol_data}.", + call = call + ) + } + + data <- data[[1]] + } + + url_list <- attachment_to_url_list(data) + + walk( + seq_along(url_list), + \(i) { + download.file( + url = url_list[[i]], + destfile = file.path( + path %||% getwd(), + names(url_list)[[i]] + ), + ... + ) + } + ) +} + +#' Convert attachment column to named vector of URLs named with file names +#' +#' @param data Attachment data frame list column. +#' @noRd +attachment_to_url_list <- function(.l, filename = NULL) { + url <- map(.l, \(x) { + x[["url"]] + }) + + filename <- filename %||% map(.l, \(x) { + x[["filename"]] + }) + + set_names(unlist(url), unlist(filename)) +} diff --git a/man/download_attachment_field.Rd b/man/download_attachment_field.Rd new file mode 100644 index 00000000..803aa733 --- /dev/null +++ b/man/download_attachment_field.Rd @@ -0,0 +1,35 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/attachments.R +\name{download_attachment_field} +\alias{download_attachment_field} +\title{Download files from an Airtable attachment field} +\usage{ +download_attachment_field( + data, + field = NULL, + path = NULL, + ..., + call = caller_env() +) +} +\arguments{ +\item{data}{An Airtable data frame with an attachment list column selected +with the field parameter \emph{or} an attachment list column.} + +\item{field}{Attachment field or column name as string or tidyselect function.} + +\item{path}{Path to download file.} + +\item{call}{The execution environment of a currently +running function, e.g. \code{caller_env()}. The function will be +mentioned in error messages as the source of the error. See the +\code{call} argument of \code{\link[rlang:abort]{abort()}} for more information.} +} +\description{ +Learn more about the attachment field type: +\url{https://airtable.com/developers/web/api/field-model#multipleattachment} + +Learn more about attachments in Airtable: +\url{https://support.airtable.com/docs/airtable-attachment-url-behavior} +} +\keyword{internal} From c99dcec52d8b5b9e3aa86759ac6c569de46ffab6 Mon Sep 17 00:00:00 2001 From: your name Date: Wed, 29 May 2024 14:54:44 -0400 Subject: [PATCH 05/10] fix: correct bug introduced w/ download_attachment_field --- R/attachments.R | 2 +- R/read_airtable.R | 10 ++++++++-- R/update_records.R | 6 +++--- 3 files changed, 12 insertions(+), 6 deletions(-) diff --git a/R/attachments.R b/R/attachments.R index a9a2bd64..14335162 100644 --- a/R/attachments.R +++ b/R/attachments.R @@ -20,7 +20,7 @@ download_attachment_field <- function(data, call = caller_env()) { if (!is.null(field)) { check_data_frame(data, call = call) - data <- select_cols(.data = data, .field = field, call = call) + data <- select_cols(tidyselect::any_of(field), .data = data, call = call) ncol_data <- ncol(data) if (ncol_data > 1) { diff --git a/R/read_airtable.R b/R/read_airtable.R index 90052767..5b14d6ce 100644 --- a/R/read_airtable.R +++ b/R/read_airtable.R @@ -167,7 +167,11 @@ list_records <- function(airtable = NULL, if (!is_null(model) && simplifyVector) { # Reorder columns to match order in model if supplied - records <- arrange_record_cols(records, metadata, model) + records <- arrange_record_cols( + records = records, + metadata = metadata, + model = model + ) } records @@ -649,8 +653,10 @@ arrange_record_cols <- function(records, model_nm <- names_at(model[["fields"]]) } + cols <- c(metadata_nm, model_nm) + select_cols( - tidyselect::any_of(c(metadata_nm, model_nm)), + tidyselect::any_of(cols), .data = records, error_call = call ) diff --git a/R/update_records.R b/R/update_records.R index 3040f293..b2bd2a18 100644 --- a/R/update_records.R +++ b/R/update_records.R @@ -263,7 +263,7 @@ get_record_id_col <- function(data, ) } - data <- select_cols(tidyselect::all_of(id_col), .data = data, call = call) + data <- select_cols(tidyselect::all_of(id_col), .data = data, error_call = call) n_cols <- ncol(data) if (n_cols != 1) { @@ -306,7 +306,7 @@ get_data_columns <- function(data, data <- data[, names(data) != id_col, drop = FALSE] } - select_cols(columns, .data = data, call = call) + select_cols(columns, .data = data, error_call = call) } #' Get names of selected columns @@ -335,7 +335,7 @@ select_cols <- function(..., .env = caller_env(), error_call = caller_env()) { pos <- tidyselect::eval_select( - expr = expr(c({{ .field }}, ...)), + expr = expr(...), data = .data, env = .env, strict = .strict, From 98cd8b5514c2f676f2d4ab01c91f5ef62b99121e Mon Sep 17 00:00:00 2001 From: your name Date: Wed, 29 May 2024 14:55:06 -0400 Subject: [PATCH 06/10] refactor: add minimum version for cli --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 3e6656b8..10f5d19a 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -14,7 +14,7 @@ License: MIT + file LICENSE URL: https://matthewjrogers.github.io/rairtable/ BugReports: https://github.com/matthewjrogers/rairtable/issues Imports: - cli, + cli (>= 2.5.0), glue, httr2 (>= 0.2.3), lifecycle, From a5abe8c18c6ea9f14964f19ee7217076c8d7e947 Mon Sep 17 00:00:00 2001 From: Eli Pousson Date: Tue, 29 Oct 2024 00:21:22 -0400 Subject: [PATCH 07/10] Simplify print method for airtable objects --- R/airtable.R | 16 ++++++++++------ 1 file changed, 10 insertions(+), 6 deletions(-) diff --git a/R/airtable.R b/R/airtable.R index 6de0223c..38a82c54 100644 --- a/R/airtable.R +++ b/R/airtable.R @@ -181,20 +181,24 @@ vec_ptype_full.airtable <- function(x, ...) { print.airtable <- function(x, ...) { cli::cli_text("{.cls {class(x)}}") + rule_msg <- "" + if (!is_empty(x$description)) { - cli::cli_rule("{.valuel {x$description}}") - } else { - cli::cli_rule() + rule_msg <- "{.valuel {x$description}}" } + cli::cli_rule(rule_msg) + text <- c("*" = "Base: {.field {x$base}}") if (!is_empty(x$table)) { + tbl_msg <- "Table: {.val {x$name}} - {.field {x$table}}" + if (is_empty(x$name)) { - text <- c(text, "*" = "Table: {.field {x$table}}") - } else { - text <- c(text, "*" = "Table: {.val {x$name}} - {.field {x$table}}") + tbl_msg <- "Table: {.field {x$table}}" } + + text <- c(text, "*" = tbl_msg) } if (!is_empty(x$view)) { From 2cf3de25a41a103d26e4f746343d420c91c1ef65 Mon Sep 17 00:00:00 2001 From: Eli Pousson Date: Tue, 29 Oct 2024 00:25:04 -0400 Subject: [PATCH 08/10] Update NEWS --- NEWS.md | 30 +++++++++++++++++++++++++++++- 1 file changed, 29 insertions(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index 039ad03b..41d22b70 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,2 +1,30 @@ +# rairtable (development) + +This is a major update of the original version of the rairtable package. The package has been refactored to use the `{httr2}` package, a large number of new functions have been added, along with new features for existing functions. + +General changes: + +* Add cli, glue, httr2, lifecycle, rlang, tibble, tidyselect, and vctrs to Imports. +* Remove httr, jsonlite, tibble, dplyr, crayon, parallel, and progress from Imports. +* Add httptest2, knitr, rmarkdown, and testthat to Suggests. + +New functions for working with several components of the Airtable Web API: + +* Bases: `create_base()`, `list_bases()`, and `get_base_schema()` +* Records: `list_records()` and `get_record()` +* Tables and table configurations: `create_table()`, `get_table_model()`, `get_table_models()`, `make_table_config()`, and `copy_table_config()` +* Fields and field configurations: `create_field()`, `update_field()`, `get_field_config()`, and `make_field_config()` +* Comments: `list_comments()`, `create_comment()`, `delete_comment()` + +Updated functions: + +* `airtable()` now supports parsing Airtable URLs to derive Airtable base, table, and view ID values. Support for parsing URLs is now available for most functions in the package. +* `read_airtable()` (along with `list_records()`) now supports the full range of parameters for the record query API. + +Other changes: + +* Add @elipousson as co-author. + # rairtable 0.1.1 -Basic Airtable CRUD functionality \ No newline at end of file + +* Basic Airtable CRUD functionality From e6fe56c59d1127f45c8d8ab3185d0c1e4c58bbad Mon Sep 17 00:00:00 2001 From: Eli Pousson Date: Tue, 29 Oct 2024 00:26:17 -0400 Subject: [PATCH 09/10] Tidy DESCRIPTION Add Language --- DESCRIPTION | 12 +++++++----- man/rairtable-package.Rd | 1 + 2 files changed, 8 insertions(+), 5 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 10f5d19a..51c6600a 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -11,8 +11,11 @@ Maintainer: Matthew Rogers Description: Create, read, update, and delete Airtable records or read base metadata using the Airtable Web API. License: MIT + file LICENSE -URL: https://matthewjrogers.github.io/rairtable/ +URL: https://github.com/matthewjrogers/rairtable, + https://matthewjrogers.github.io/rairtable/ BugReports: https://github.com/matthewjrogers/rairtable/issues +Depends: + R (>= 2.10) Imports: cli (>= 2.5.0), glue, @@ -33,8 +36,7 @@ VignetteBuilder: knitr Config/testthat/edition: 3 Encoding: UTF-8 -Roxygen: list(markdown = TRUE) -RoxygenNote: 7.2.3 -Depends: - R (>= 2.10) +Language: en-US LazyData: true +Roxygen: list(markdown = TRUE) +RoxygenNote: 7.3.2 diff --git a/man/rairtable-package.Rd b/man/rairtable-package.Rd index e51e3163..82dbd240 100644 --- a/man/rairtable-package.Rd +++ b/man/rairtable-package.Rd @@ -11,6 +11,7 @@ Create, read, update, and delete Airtable records or read base metadata using th \seealso{ Useful links: \itemize{ + \item \url{https://github.com/matthewjrogers/rairtable} \item \url{https://matthewjrogers.github.io/rairtable/} \item Report bugs at \url{https://github.com/matthewjrogers/rairtable/issues} } From 2425a60d19fb4f83604ec32c0392728175babbb4 Mon Sep 17 00:00:00 2001 From: Eli Pousson Date: Tue, 29 Oct 2024 00:28:04 -0400 Subject: [PATCH 10/10] Update docs for return_data_resp --- man/return_data_resp.Rd | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/man/return_data_resp.Rd b/man/return_data_resp.Rd index 504ac81d..9a506980 100644 --- a/man/return_data_resp.Rd +++ b/man/return_data_resp.Rd @@ -9,7 +9,7 @@ return_data_resp(data = NULL, resp = NULL, return_data = TRUE) \arguments{ \item{data}{Input data frame or list} -\item{resp}{A response object.} +\item{resp}{A httr2 \link[httr2]{response} object, created by \code{\link[httr2:req_perform]{req_perform()}}.} \item{return_data}{If \code{FALSE}, return JSON response from the Airtable web API as a list. If \code{TRUE} (default) and data is not \code{NULL}, return input data