updated to 0.4.1

ropensci · May 22, 2024 · 6e2dcdc · 6e2dcdc
1 parent bd96ea6
commit 6e2dcdc
Show file tree

Hide file tree

Showing 34 changed files with 704 additions and 552 deletions.
diff --git a/R/active_tasks.R b/R/active_tasks.R
@@ -7,14 +7,15 @@
 #' # Create a CouchDB connection client
 #' user <- Sys.getenv("COUCHDB_TEST_USER")
 #' pwd <- Sys.getenv("COUCHDB_TEST_PWD")
-#' (x <- Cushion$new(user=user, pwd=pwd))
+#' (x <- Cushion$new(user = user, pwd = pwd))
 #'
 #' active_tasks(x)
-#' active_tasks(x, as = 'json')
+#' active_tasks(x, as = "json")
 #' }
-active_tasks <- function(cushion, as = 'list', ...) {
+active_tasks <- function(cushion, as = "list", ...) {
   check_cushion(cushion)
-  sofa_GET(file.path(cushion$make_url(), '_active_tasks'),
-           as = as, headers = cushion$get_headers(),
-           auth = cushion$get_auth(), ...)
+  sofa_GET(file.path(cushion$make_url(), "_active_tasks"),
+    as = as, headers = cushion$get_headers(),
+    auth = cushion$get_auth(), ...
+  )
 }
diff --git a/R/attach.r b/R/attach.r
@@ -20,78 +20,89 @@
 #' @examples \dontrun{
 #' user <- Sys.getenv("COUCHDB_TEST_USER")
 #' pwd <- Sys.getenv("COUCHDB_TEST_PWD")
-#' (x <- Cushion$new(user=user, pwd=pwd))
+#' (x <- Cushion$new(user = user, pwd = pwd))
 #'
 #' if ("foodb" %in% db_list(x)) {
-#'   invisible(db_delete(x, dbname="foodb"))
+#'   invisible(db_delete(x, dbname = "foodb"))
 #' }
-#' db_create(x, dbname='foodb')
+#' db_create(x, dbname = "foodb")
 #'
 #' # create an attachment on an existing document
 #' ## create a document first
 #' doc <- '{"name":"stuff", "drink":"soda"}'
-#' doc_create(x, dbname="foodb", doc=doc, docid="asoda")
+#' doc_create(x, dbname = "foodb", doc = doc, docid = "asoda")
 #'
 #' ## create a csv attachment
 #' row.names(mtcars) <- NULL
 #' file <- tempfile(fileext = ".csv")
 #' write.csv(mtcars, file = file, row.names = FALSE)
-#' doc_attach_create(x, dbname="foodb", docid="asoda",
-#'   attachment=file, attname="mtcarstable.csv")
+#' doc_attach_create(x,
+#'   dbname = "foodb", docid = "asoda",
+#'   attachment = file, attname = "mtcarstable.csv"
+#' )
 #'
 #' ## create a binary (png) attachment
 #' file <- tempfile(fileext = ".png")
 #' png(file)
 #' plot(1:10)
 #' dev.off()
-#' doc_attach_create(x, dbname="foodb", docid="asoda",
-#'   attachment=file, attname="img.png")
+#' doc_attach_create(x,
+#'   dbname = "foodb", docid = "asoda",
+#'   attachment = file, attname = "img.png"
+#' )
 #'
 #' ## create a binary (pdf) attachment
 #' file <- tempfile(fileext = ".pdf")
 #' pdf(file)
 #' plot(1:10)
 #' dev.off()
-#' doc_attach_create(x, dbname="foodb", docid="asoda",
-#'   attachment=file, attname="plot.pdf")
+#' doc_attach_create(x,
+#'   dbname = "foodb", docid = "asoda",
+#'   attachment = file, attname = "plot.pdf"
+#' )
 #'
 #' # get info for an attachment (HEAD request)
-#' doc_attach_info(x, "foodb", docid="asoda", attname="mtcarstable.csv")
-#' doc_attach_info(x, "foodb", docid="asoda", attname="img.png")
-#' doc_attach_info(x, "foodb", docid="asoda", attname="plot.pdf")
+#' doc_attach_info(x, "foodb", docid = "asoda", attname = "mtcarstable.csv")
+#' doc_attach_info(x, "foodb", docid = "asoda", attname = "img.png")
+#' doc_attach_info(x, "foodb", docid = "asoda", attname = "plot.pdf")
 #'
 #' # get an attachment (GET request)
-#' res <- doc_attach_get(x, "foodb", docid="asoda",
-#'   attname="mtcarstable.csv", type = "text")
+#' res <- doc_attach_get(x, "foodb",
+#'   docid = "asoda",
+#'   attname = "mtcarstable.csv", type = "text"
+#' )
 #' read.csv(text = res)
-#' doc_attach_get(x, "foodb", docid="asoda", attname="img.png")
-#' doc_attach_get(x, "foodb", docid="asoda", attname="plot.pdf")
+#' doc_attach_get(x, "foodb", docid = "asoda", attname = "img.png")
+#' doc_attach_get(x, "foodb", docid = "asoda", attname = "plot.pdf")
 #' ## OR, don't specify an attachment and list the attachments
-#' (attchms <- doc_attach_get(x, "foodb", docid="asoda", type="text"))
+#' (attchms <- doc_attach_get(x, "foodb", docid = "asoda", type = "text"))
 #' jsonlite::fromJSON(attchms)
 #'
 #' # delete an attachment
-#' doc_attach_delete(x, "foodb", docid="asoda", attname="mtcarstable.csv")
-#' doc_attach_delete(x, "foodb", docid="asoda", attname="img.png")
-#' doc_attach_delete(x, "foodb", docid="asoda", attname="plot.pdf")
+#' doc_attach_delete(x, "foodb", docid = "asoda", attname = "mtcarstable.csv")
+#' doc_attach_delete(x, "foodb", docid = "asoda", attname = "img.png")
+#' doc_attach_delete(x, "foodb", docid = "asoda", attname = "plot.pdf")
 #' }
 
 #' @export
 #' @rdname attachments
 doc_attach_create <- function(cushion, dbname, docid, attachment, attname,
                               as = "list", ...) {
-
   check_cushion(cushion)
   if (!file.exists(attachment)) stop("the file does not exist", call. = FALSE)
   revget <- db_revisions(cushion, dbname = dbname, docid = docid)[1]
   url <- file.path(cushion$make_url(), dbname, docid, attname)
   sofa_PUT_dac(url, as,
-           body = crul::upload(attachment),
-           rev = revget,
-           headers = c(list(
-            `Content-Type` = mime::guess_type(attachment)),
-            cushion$get_headers()),
-           auth = cushion$get_auth(), ...)
+    body = crul::upload(attachment),
+    rev = revget,
+    headers = c(
+      list(
+        `Content-Type` = mime::guess_type(attachment)
+      ),
+      cushion$get_headers()
+    ),
+    auth = cushion$get_auth(), ...
+  )
 }
 
 #' @export
@@ -104,9 +115,9 @@ doc_attach_info <- function(cushion, dbname, docid, attname, ...) {
 
 #' @export
 #' @rdname attachments
-doc_attach_get <- function(cushion, dbname, docid, attname = NULL,
-  type = "raw", ...) {
-
+doc_attach_get <- function(
+    cushion, dbname, docid, attname = NULL,
+    type = "raw", ...) {
   check_cushion(cushion)
   if (is.null(attname)) {
     url <- file.path(cushion$make_url(), dbname, docid)
@@ -116,14 +127,15 @@ doc_attach_get <- function(cushion, dbname, docid, attname = NULL,
     query <- list()
   }
   revget <- db_revisions(cushion, dbname = dbname, docid = docid)[1]
-  type <- match.arg(type, c('text', 'raw'))
+  type <- match.arg(type, c("text", "raw"))
   cli <- crul::HttpClient$new(
     url = url,
     headers = sc(c(ct_json, cushion$get_headers(), list(`If-Match` = revget))),
-    opts = sc(c(cushion$get_auth(), list(...))))
+    opts = sc(c(cushion$get_auth(), list(...)))
+  )
   res <- cli$get(query = query)
   stop_status(res)
-  if (type == 'raw') res$content else res$parse("UTF-8")
+  if (type == "raw") res$content else res$parse("UTF-8")
 }
 
 #' @export
@@ -132,23 +144,26 @@ doc_attach_delete <- function(cushion, dbname, docid, attname, as = "list", ...)
   check_cushion(cushion)
   revget <- db_revisions(cushion, dbname = dbname, docid = docid)[1]
   url <- file.path(cushion$make_url(), dbname, docid, attname)
-  sofa_DELETE(url, as,
-              sc(c(cushion$get_headers(),
-                   list(Accept = "application/json", `If-Match` = revget))),
-              cushion$get_auth(), ...)
+  sofa_DELETE(
+    url, as,
+    sc(c(
+      cushion$get_headers(),
+      list(Accept = "application/json", `If-Match` = revget)
+    )),
+    cushion$get_auth(), ...
+  )
 }
 
-sofa_PUT_dac <- function(url, as = 'list', body, rev,
-                         encode = "json", headers = NULL, auth = NULL, ...){
-
-  as <- match.arg(as, c('list','json'))
+sofa_PUT_dac <- function(url, as = "list", body, rev,
+                         encode = "json", headers = NULL, auth = NULL, ...) {
+  as <- match.arg(as, c("list", "json"))
   cli <- crul::HttpClient$new(
     url = url,
     headers = sc(c(headers, list(`If-Match` = rev))),
-    opts = sc(c(auth, list(...))))
+    opts = sc(c(auth, list(...)))
+  )
   res <- cli$put(body = body, encode = encode)
   res$raise_for_status()
-  tt <- res$parse('UTF-8')
-  if (as == 'json') tt else jsonlite::fromJSON(tt, FALSE)
+  tt <- res$parse("UTF-8")
+  if (as == "json") tt else jsonlite::fromJSON(tt, FALSE)
 }
-
diff --git a/R/cushion.R b/R/cushion.R
@@ -13,7 +13,7 @@
 #' # Create a CouchDB connection client
 #' user <- Sys.getenv("COUCHDB_TEST_USER")
 #' pwd <- Sys.getenv("COUCHDB_TEST_PWD")
-#' (x <- Cushion$new(user=user, pwd=pwd))
+#' (x <- Cushion$new(user = user, pwd = pwd))
 #'
 #' ## metadata
 #' x$host
@@ -23,7 +23,7 @@
 #'
 #' ## ping the CouchDB server
 #' x$ping()
-#' 
+#'
 #' ## get CouchDB version
 #' x$version()
 #'
@@ -37,13 +37,13 @@
 #'   db_create(x, "sofadb")
 #' }
 #' doc1 <- '{"name": "drink", "beer": "IPA", "score": 5}'
-#' doc_create(x, dbname="sofadb", docid="abeer", doc1)
+#' doc_create(x, dbname = "sofadb", docid = "abeer", doc1)
 #'
 #' # bulk create
 #' if (!"mymtcars" %in% db_list(x)) {
 #'   db_create(x, "mymtcars")
 #' }
-#' db_bulk_create(x, dbname="mymtcars", doc = mtcars)
+#' db_bulk_create(x, dbname = "mymtcars", doc = mtcars)
 #' db_list(x)
 #'
 #' ## database info
@@ -74,13 +74,13 @@ Cushion <- R6::R6Class(
   "Cushion",
   public = list(
     #' @field host (character) host
-    host = '127.0.0.1',
+    host = "127.0.0.1",
     #' @field port (integer) port
     port = 5984,
     #' @field path (character) url path, if any
     path = NULL,
     #' @field transport (character) transport schema, (http|https)
-    transport = 'http',
+    transport = "http",
     #' @field user (character) username
     user = NULL,
     #' @field pwd (character) password
@@ -127,17 +127,20 @@ Cushion <- R6::R6Class(
       cat(paste0("  path: ", self$path), sep = "\n")
       cat(paste0("  type: ", self$type), sep = "\n")
       cat(paste0("  user: ", self$user), sep = "\n")
-      cat(paste0("  pwd: ", if (!is.null(self$pwd)) '<secret>' else ''),
-          sep = "\n")
+      cat(paste0("  pwd: ", if (!is.null(self$pwd)) "<secret>" else ""),
+        sep = "\n"
+      )
       invisible(self)
     },
 
     #' @description Ping the CouchDB server
     #' @param as (character) One of list (default) or json
     #' @param ... curl options passed to [crul::verb-GET]
-    ping = function(as = 'list', ...) {
-      sofa_GET(self$make_url(), as = as, query = NULL,
-        headers = self$get_headers(), auth = self$get_auth(), ...)
+    ping = function(as = "list", ...) {
+      sofa_GET(self$make_url(),
+        as = as, query = NULL,
+        headers = self$get_headers(), auth = self$get_auth(), ...
+      )
     },
 
     #' @description Construct full base URL from the pieces in the
@@ -161,15 +164,15 @@ Cushion <- R6::R6Class(
     #' @description Get the CouchDB version as a numeric
     version = function() {
       z <- self$ping()
-      ver <- as.numeric(paste0(strx(z$version, '[0-9]'), collapse=""))
+      ver <- as.numeric(paste0(strx(z$version, "[0-9]"), collapse = ""))
       if (nchar(ver) < 3) {
-        ver <- as.numeric(paste0(c(ver, rep("0", times=3-nchar(ver))),
-          collapse=""))
+        ver <- as.numeric(paste0(c(ver, rep("0", times = 3 - nchar(ver))),
+          collapse = ""
+        ))
       }
       return(ver)
     }
   ),
-
   private = list(
     auth_headers = NULL
   )

diff --git a/R/db_alldocs.R b/R/db_alldocs.R
@@ -16,53 +16,57 @@
 #' @examples \dontrun{
 #' user <- Sys.getenv("COUCHDB_TEST_USER")
 #' pwd <- Sys.getenv("COUCHDB_TEST_PWD")
-#' (x <- Cushion$new(user=user, pwd=pwd))
+#' (x <- Cushion$new(user = user, pwd = pwd))
 #'
 #' if ("leothelion" %in% db_list(x)) {
-#'   invisible(db_delete(x, dbname="leothelion"))
+#'   invisible(db_delete(x, dbname = "leothelion"))
 #' }
-#' db_create(x, dbname='leothelion')
-#' db_bulk_create(x, mtcars, dbname="leothelion")
+#' db_create(x, dbname = "leothelion")
+#' db_bulk_create(x, mtcars, dbname = "leothelion")
 #'
-#' db_alldocs(x, dbname="leothelion")
-#' db_alldocs(x, dbname="leothelion", as='json')
-#' db_alldocs(x, dbname="leothelion", limit=2)
-#' db_alldocs(x, dbname="leothelion", limit=2, include_docs=TRUE)
+#' db_alldocs(x, dbname = "leothelion")
+#' db_alldocs(x, dbname = "leothelion", as = "json")
+#' db_alldocs(x, dbname = "leothelion", limit = 2)
+#' db_alldocs(x, dbname = "leothelion", limit = 2, include_docs = TRUE)
 #'
 #' # curl options
-#' res <- db_alldocs(x, dbname="leothelion", verbose = TRUE)
-#' 
+#' res <- db_alldocs(x, dbname = "leothelion", verbose = TRUE)
+#'
 #' # write data to disk - useful when data is very large
 #' ## create omdb dataset first
 #' file <- system.file("examples/omdb.json", package = "sofa")
 #' strs <- readLines(file)
 #' if ("omdb" %in% db_list(x)) {
-#'   invisible(db_delete(x, dbname="omdb"))
+#'   invisible(db_delete(x, dbname = "omdb"))
 #' }
-#' db_create(x, dbname='omdb')
+#' db_create(x, dbname = "omdb")
 #' invisible(db_bulk_create(x, "omdb", strs))
 #'
 #' ## get all docs, writing them to disk
-#' res <- db_alldocs(x, dbname="omdb", disk = (f <- tempfile(fileext=".json")))
+#' res <- db_alldocs(x, dbname = "omdb", disk = (f <- tempfile(fileext = ".json")))
 #' res
 #' readLines(res, n = 10)
 #' }
-
-db_alldocs <- function(cushion, dbname, descending=NULL, startkey=NULL,
-  endkey=NULL, limit=NULL, include_docs=FALSE, as='list', 
-  disk = NULL, ...) {
-
+db_alldocs <- function(
+    cushion, dbname, descending = NULL, startkey = NULL,
+    endkey = NULL, limit = NULL, include_docs = FALSE, as = "list",
+    disk = NULL, ...) {
   check_cushion(cushion)
   check_if(include_docs, "logical")
   args <- sc(list(
     descending = descending, startkey = startkey, endkey = endkey,
-    limit = limit, include_docs = asl(include_docs)))
+    limit = limit, include_docs = asl(include_docs)
+  ))
   call_ <- sprintf("%s/%s/_all_docs", cushion$make_url(), dbname)
   if (is.null(disk)) {
-    sofa_GET(call_, as, query = args, cushion$get_headers(),
-           cushion$get_auth(), ...)
+    sofa_GET(call_, as,
+      query = args, cushion$get_headers(),
+      cushion$get_auth(), ...
+    )
   } else {
-    sofa_GET_disk(call_, as, query = args, cushion$get_headers(),
-           cushion$get_auth(), disk, ...)
+    sofa_GET_disk(call_, as,
+      query = args, cushion$get_headers(),
+      cushion$get_auth(), disk, ...
+    )
   }
 }